Day 8 - Scenic Tree Visibility

Dec 8

All 2022 Problems

Problem Overview

Today is our first 2D grid problem of the year. We're looking at a forest, and each number in the grid is the height of a particular tree. We want to answer two different questions about the grid. First, how many trees are "visible" from the outside of the grid? We'll imagine we walk around the grid from all four sides and look at each row and column until we hit a tree that is too tall to see any other trees behind.

For the second part, we'll consider each individual location inside the grid and determine how many trees are visible from that location.

Solution Approach and Insights

There's nothing too clever about my solution. Our scale is still small enough that we can more or less do brute force explorations as long as we're using an array.

Parsing the Input

So today's input is a 2D array of single-digit integers.

From last year, I had a utility for this exact case: parse2DDigitArray.

type Coord2 = (Int, Int)
type Grid2 a = Array Coord2 a

-- Only single digit numbers
parse2DDigitArray :: (Monad m) => ParsecT Void Text m (Grid2 Int)
parse2DDigitArray = digitsToArray <$> sepEndBy1 parseDigitLine eol

digitsToArray :: [[Int]] -> Grid2 Int
digitsToArray inputs = A.listArray ((0, 0), (length inputs - 1, length (head inputs) - 1)) (concat inputs)

parseDigitLine :: ParsecT Void Text m [Int]
parseDigitLine = fmap digitToInt <$> some digitChar

So we can pull it into our solution like so:

type InputType = Grid2 Int

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = parse2DDigitArray

Getting the Solution

For part 1, we need to consider each column from two directions and each row from two directions, and count the number of visible trees going down the line. Let's start with a function to do this in the vertical direction.

Instead of returning a raw count, we'll write this function to be used with a fold. It will take a Set of visible coordinates and return a modified set. This will prevent us from counting the same location twice from different directions. It will have two preliminary arguments - the grid and the list of row indices.

countVisibleVertical :: (MonadLogger m) => Grid2 Int -> [Int] -> S.Set Coord2 -> Int -> m (S.Set Coord2)
countVisibleVertical treeGrid rows prev col  = ...

Within this function, we'll fold through the row indices. However, in addition to using the Set within our folding type, we'll also keep track of the highest tree we've seen so far. If the next tree height is larger than the highest tree we've seen so far, we insert this new item into the visited set and update the height. Otherwise, neither changes.

countVisibleVertical :: (MonadLogger m) => Grid2 Int -> [Int] -> S.Set Coord2 -> Int -> m (S.Set Coord2)
countVisibleVertical treeGrid rows prev col  = ...
  where
    assessRow :: (S.Set Coord2, Int) -> Int -> (S.Set Coord2, Int)
    assessRow (prevSet, highestSeen) row =
      let nextHeight = treeGrid A.! (row, col)
      in  if nextHeight > highestSeen then (S.insert (row, col) prevSet, nextHeight) else (prevSet, highestSeen)

And now we complete the function by performing the fold (we start with our initial set and a minimum height of -1) and then only return the set.

countVisibleVertical :: (MonadLogger m) => Grid2 Int -> [Int] -> S.Set Coord2 -> Int -> m (S.Set Coord2)
countVisibleVertical treeGrid rows prev col = return $ fst $ foldl assessRow (prev, -1) rows
  where
    assessRow :: (S.Set Coord2, Int) -> Int -> (S.Set Coord2, Int)
    assessRow (prevSet, highestSeen) row =
      let nextHeight = treeGrid A.! (row, col)
      in  if nextHeight > highestSeen then (S.insert (row, col) prevSet, nextHeight) else (prevSet, highestSeen)

We can do the same thing in the horizontal direction. This function looks very similar, just reversing rows and columns.

countVisibleHorizontal :: (MonadLogger m) => Grid2 Int -> [Int] -> S.Set Coord2 -> Int -> m (S.Set Coord2)
countVisibleHorizontal treeGrid columns prev row = return $ fst $ foldl assessColumn (prev, -1) columns
  where
    assessColumn :: (S.Set Coord2, Int) -> Int -> (S.Set Coord2, Int)
    assessColumn (prevSet, highestSeen) col =
      let nextHeight = treeGrid A.! (row, col)
      in  if nextHeight > highestSeen then (S.insert (row, col) prevSet, nextHeight) else (prevSet, highestSeen)

Now we just have to run these functions in turn. Twice with horizontal, twice with vertical, and passing the resulting set each time.

type EasySolutionType = Int

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy treeGrid = do
  let rows = [0..(fst . snd . A.bounds $ treeGrid)]
  let cols = [0..(snd . snd . A.bounds $ treeGrid)]
  s1 <- foldM (countVisibleHorizontal treeGrid cols) S.empty rows
  s2 <- foldM (countVisibleHorizontal treeGrid (reverse cols)) s1 rows
  s3 <- foldM (countVisibleVertical treeGrid rows) s2 cols
  S.size <$> foldM (countVisibleVertical treeGrid (reverse rows)) s3 cols

Part 2

In part 2, we just have to loop through each possible index in our grid. Then we'll apply a function to assess the scenic score at that location. We just have to look in each direction.

assessScenicScore :: (MonadLogger m) => Grid2 Int -> Coord2 -> m HardSolutionType
assessScenicScore treeGrid (row, col) = return $ lookUp * lookLeft * lookDown * lookRight
    heightHere = treeGrid A.! (row, col)
    (maxRow, maxCol) = snd (A.bounds treeGrid)
    lookUp = ...
    lookLeft = ...
    lookDown = ...
    lookRight = ...

Within each case, we have to have a special case of 0 when we're at the edge. Then we'll use takeWhile to find the number of indices that are smaller than our present height. After that, there's one more edge case if we count all the trees in that direction. Here's the "up" case:

assessScenicScore :: (MonadLogger m) => Grid2 Int -> Coord2 -> m HardSolutionType
assessScenicScore treeGrid (row, col) = return $ lookUp * lookLeft * lookDown * lookRight
    heightHere = treeGrid A.! (row, col)
    (maxRow, maxCol) = snd (A.bounds treeGrid)
    lookUp = if row == 0 then 0
      else
        let smallerTrees = length $ takeWhile (\r -> treeGrid A.! (r, col) < heightHere) [(row - 1),(row - 2)..0]
        in  if smallerTrees == row then smallerTrees else smallerTrees + 1
    lookLeft = ...
    lookDown = ...
    lookRight = ...

And here's the full function:

type HardSolutionType = EasySolutionType

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard treeGrid = maximum <$> mapM (assessScenicScore treeGrid) (A.indices treeGrid)

assessScenicScore :: (MonadLogger m) => Grid2 Int -> Coord2 -> m HardSolutionType
assessScenicScore treeGrid (row, col) = return $ lookUp * lookLeft * lookDown * lookRight
  where
    heightHere = treeGrid A.! (row, col)
    (maxRow, maxCol) = snd (A.bounds treeGrid)
    lookUp = if row == 0 then 0
      else
        let smallerTrees = length $ takeWhile (\r -> treeGrid A.! (r, col) < heightHere) [(row - 1),(row - 2)..0]
        in  if smallerTrees == row then smallerTrees else smallerTrees + 1
    lookLeft = if col == 0 then 0
      else
        let smallerTrees = length $ takeWhile (\c -> treeGrid A.! (row, c) < heightHere) [(col - 1),(col-2)..0]
        in  if smallerTrees == col then smallerTrees else smallerTrees + 1
    lookDown = if row == maxRow then 0
      else
        let smallerTrees = length $ takeWhile (\r -> treeGrid A.! (r, col) < heightHere) [(row + 1)..maxRow]
        in  if smallerTrees + row == maxRow then smallerTrees else smallerTrees + 1
    lookRight = if col == maxCol then 0
      else
        let smallerTrees = length $ takeWhile (\c -> treeGrid A.! (row, c) < heightHere) [(col + 1)..maxCol]
        in  if smallerTrees + col == maxCol then smallerTrees else smallerTrees + 1

And doing the full processing is easy! Just map this function over all the indices:

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard treeGrid = maximum <$> mapM (assessScenicScore treeGrid) (A.indices treeGrid)

Answering the Question

There's no additional processing for this problem. We just have the two steps.

solveEasy :: FilePath -> IO (Maybe Int)
solveEasy fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputEasy input

solveHard :: FilePath -> IO (Maybe Int)
solveHard fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputHard input

So this gives us our complete solution!

Video

YouTube Link

Advent of Code

James Bowen