/wakamoleguy

Advent of Code 2022 - Day 8: Treetop Tree House

It's Day 8: Treetop Tree House, or at least it was a couple days ago... I'm still catching up. Today, we're faced with a grid of trees, and asked to do some visibility checks.

First thought: Oy vey, another Array problem?

At Least the Parsing is Easy

Let's read in our grid as a list of numbers, and then drop them in an array. Our grid size is conveniently square, so we can get away with an easy length check.

input :: IO (Array (Int, Int) Int)
input = do
  s <- lines <$> readDay 2022 8
  return $ listArray ((1, 1), (length s, length s)) $ digitToInt <$> concat s

Part 1: Visibility from the Edge

For Part 1, we want to know how many trees are visible from the outside. To do this, we'll iterate over each tree, and check if it's visible. This will do some extra work, but it's very simple.

There are two main ways to reduce the work here. One is to check each of the rows and columns directly from the outside. Imagine shooting a ray into the grid and seeing how many trees are passed before it hits something. However, we'd have to store the exact trees in a Set, to avoid double-counting trees that are visible from other directions.

The second way to reduce the double work is to calculate each tree's visiblity based on the trees next to it. A tree is visible from the west only if it's western neighbor is visible and smaller.

How do we iterate over each tree? Well, a tree is really just an index in the array! Let's make some helper functions that can start with a tree, and return all of the other trees in a particular direction, ending at the edge of the grid:

type Tree = (Int, Int)

-- From a given index, step in a cardinal direction until we hit a boundary
northFrom, southFrom, eastFrom, westFrom :: Tree -> (Tree, Tree) -> [Tree]
northFrom (x, y) b = takeWhile (inRange b) [(x, y - d) | d <- [1 ..]]
southFrom (x, y) b = takeWhile (inRange b) [(x, y + d) | d <- [1 ..]]
eastFrom (x, y) b = takeWhile (inRange b) [(x + d, y) | d <- [1 ..]]
westFrom (x, y) b = takeWhile (inRange b) [(x - d, y) | d <- [1 ..]]

A tree is visible if it's visible from any of these four directions. Let's use the List monad to represent this choice. We'll create a list of our 4 directions, and then define a computation that can run on any of them.

treeIsVisible :: Array Tree Int -> Tree -> Bool
treeIsVisible a t = or $ do
  stepFrom <- [northFrom, southFrom, eastFrom, westFrom]
  let trees = stepFrom t $ bounds a
  return $ all (< (a ! t)) $ fmap (a !) trees

part1 :: Array Tree Int -> Int
part1 a = length . filter (treeIsVisible a) $ indices a

Part 2 - Maximal visibility

Part 2 ends up being very similar:

  1. We will still iterate over each tree with indices a
  2. We will still use the List monad to choose one of our four directions
  3. This will result in a list of values. Instead of a boolean whether or not the given tree is visible from that direction, it will be the number of trees visible in that direction.
  4. We will combine the values together. Instead of or, we will use product
  5. Instead of filtering our trees and counting the length, we'll find the maximum resulting value.
takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = foldr (\x ys -> x : if p x then [] else ys) []

scenicScore :: Array Tree Int -> Tree -> Int
scenicScore a t = product $ do
  stepFrom <- [northFrom, southFrom, eastFrom, westFrom]
  return $ length $ takeUntil (\x -> a ! x >= a ! t) $ stepFrom t $ bounds a

part2 :: Array Tree Int -> Int
part2 a = maximum . fmap (scenicScore a) $ indices a

Full Code

module AOC2022.Day08 (spec) where

import Data.Array
import Data.Char (digitToInt)
import Input
import Test.Hspec

input :: IO (Array (Int, Int) Int)
input = do
  s <- lines <$> readDay 2022 8
  return $ listArray ((1, 1), (length s, length s)) $ digitToInt <$> concat s

spec :: IO ()
spec = hspec $ do
  describe "Day 8" $ do
    describe "Part 1" $ do
      it "runs on custom input" $ do
        myInput <- input
        part1 myInput `shouldBe` 0 -- redacted
    describe "Part 2" $ do
      it "runs on custom input" $ do
        myInput <- input
        part2 myInput `shouldBe` 0 -- redacted

type Tree = (Int, Int)

-- From a given index, step in a cardinal direction until we hit a boundary
northFrom, southFrom, eastFrom, westFrom :: Tree -> (Tree, Tree) -> [Tree]
northFrom (x, y) b = takeWhile (inRange b) [(x, y - d) | d <- [1 ..]]
southFrom (x, y) b = takeWhile (inRange b) [(x, y + d) | d <- [1 ..]]
eastFrom (x, y) b = takeWhile (inRange b) [(x + d, y) | d <- [1 ..]]
westFrom (x, y) b = takeWhile (inRange b) [(x - d, y) | d <- [1 ..]]

treeIsVisible :: Array Tree Int -> Tree -> Bool
treeIsVisible a t = or $ do
  stepFrom <- [northFrom, southFrom, eastFrom, westFrom]
  let trees = stepFrom t $ bounds a
  return $ all (< (a ! t)) $ fmap (a !) trees

part1 :: Array Tree Int -> Int
part1 a = length . filter (treeIsVisible a) $ indices a

takeUntil :: (a -> Bool) -> [a] -> [a]
takeUntil p = foldr (\x ys -> x : if p x then [] else ys) []

scenicScore :: Array Tree Int -> Tree -> Int
scenicScore a t = product $ do
  stepFrom <- [northFrom, southFrom, eastFrom, westFrom]
  return $ length $ takeUntil (\x -> a ! x >= a ! t) $ stepFrom t $ bounds a

part2 :: Array Tree Int -> Int
part2 a = maximum . fmap (scenicScore a) $ indices a

Advent of Code 2022 Series

This post is part of a series describing my Haskell solutions to Advent of Code 2022.

Next: Day 9: Rope Bridge Previous: Day 7: No Space Left On Device

Cheers!