Day 12 - Taking a Hike

Dec 12

All 2022 Problems

Problem Overview

For today's problem we're hiking through a trail represented with a 2D height map. We're given a start point (at low elevation) and an endpoint (at high elevation). We want to find the shortest path from start to end, but we can't increase our elevation by more than 1 with each step.

For the second part, instead of fixing our start position, we'll consider all the different positions with the lowest elevation. We'll see which one of these has the shortest path to the end!

Solution Approach and Insights

We can turn this into a graph problem, and because every "step" has the same cost, this is a textbook BFS problem! We'll be able to apply this bfsM function from the Algorithm.Search library.

Relevant Utilities

There are a few important pre-existing (or mostly pre-existing) utilities for 2D grids that will help with this problem.

Recall from Day 8 that we could use these functions to parse a 2D digit grid into a Haskell Array.

I then adapted the digit parser to also work with characters, resulting in this function.

Another useful helper is this function getNeighbors, which gives us the four neighbors (up/down/left/right) of a coordinate in a 2D grid, while accounting for bounds checking.

Parsing the Input

So given a sample input:

Sabqponm
abcryxxl
accszExk
acctuvwj
abdefghi

It's easy to apply the first step and get the digits into an array with our helper from above.

type InputType = (Grid2 Char, Coord2, Coord2)

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = do
  charArray <- parse2DCharacterArray
  ...

However, we want to do a bit of post-processing. As you can see from my input type definition, we want to include the start and end coordinates of the grid as well. We'll also want to substitute the correct height values for those ('a' for 'S' and 'z' for 'E') back into the grid.

We start by finding the 'S' and 'E' characters and asserting that they exist.

postProcessGrid :: (MonadLogger m) => Grid2 Char -> m InputType
postProcessGrid parsedChars = do
  let allAssocs = A.assocs parsedChars
      start = find (\(c, v) -> v == 'S') allAssocs
      end = find (\(c, v) -> v == 'E') allAssocs
  case (start, end) of
    (Just (s, _), Just (e, _)) -> ...
    _ -> logErrorN "Couldn't find start or end!" >> return (parsedChars, (0, 0), (0, 0))

Now in the case they do, we just use the Array // operator to make the substitution and create our new grid.

postProcessGrid :: (MonadLogger m) => Grid2 Char -> m InputType
postProcessGrid parsedChars = do
  let allAssocs = A.assocs parsedChars
      start = find (\(c, v) -> v == 'S') allAssocs
      end = find (\(c, v) -> v == 'E') allAssocs
  case (start, end) of
    (Just (s, _), Just (e, _)) -> do
      let newGrid = parsedChars A.// [(s, 'a'), (e, 'z')]
      return (newGrid, s, e)
    _ -> logErrorN "Couldn't find start or end!" >> return (parsedChars, (0, 0), (0, 0))

So our final parsing function looks like this:

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = do
  charArray <- parse2DCharacterArray
  lift $ postProcessGrid charArray

Getting the Solution

Now we'll fill in processInputEasy to get our first solution.

type EasySolutionType = Int

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy (parsedGrid, start, end) = ...

To get the solution, we'll apply the bfsM function mentioned above. We need three items:

The function to determine the neighboring states
The end condition
The start value

For the purposes of our Breadth First Search, we'll imagine that our "state" is just the current coordinate. So the start value and end condition are given immediately.

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy (parsedGrid, start, end) = do
  result <- bfsM (...) (\c -> return (c == end)) start
  ...

Now we need a function to calculate the neighbors. This will, of course, incorporate the getNeighbors helper above. It will also take our grid as a constant parameter:

validMoves :: (MonadLogger m) => Grid2 Char -> Coord2 -> m [Coord2]
validMoves grid current = do
  let neighbors = getNeighbors grid current
  ...

We now need to filter these values to remove neighbors that we can't move too because they are too high. This just requires comparing each new height to the current height using Data.Char.ord, and ensuring this difference is no greater than 1.

validMoves :: (MonadLogger m) => Grid2 Char -> Coord2 -> m [Coord2]
validMoves grid current = do
  let neighbors = getNeighbors grid current
      currentHeight = grid A.! current
  return $ filter (neighborTest currentHeight) neighbors
  where
    neighborTest currentHeight newCoord =
      let newHeight = grid A.! newCoord
      in  ord newHeight - ord currentHeight <= 1

And now we can fill in our definition for bfsM!

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy (parsedGrid, start, end) = do
  result <- bfsM (validMoves parsedGrid) (\c -> return (c == end)) start
  ...

The last touch is to check the result because we want its size. If it's Nothing, we'll return maxBound as an error case. Otherwise, we'll take the length of the path.

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy (parsedGrid, start, end) = do
  result <- bfsM (validMoves parsedGrid) (\c -> return (c == end)) start
  case result of
    Nothing -> return maxBound
    Just path -> return (length path)

Part 2

Now we need the "hard" solution for part 2. For this part, we take the same input but ignore the given start. Instead, we'll filter the array to find all positions with height a.

type HardSolutionType = EasySolutionType

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard (parsedGrid, _, end) = do
  let allStarts = fst <$> filter (\(_, h) -> h == 'a') (A.assocs parsedGrid)
  ...

Now we can map through each of these starts, and use our easy solution function to get the shortest path length! Then we'll take the minimum of these to get our answer.

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard (parsedGrid, _, end) = do
  let allStarts = fst <$> filter (\(_, h) -> h == 'a') (A.assocs parsedGrid)
  results <- mapM (\start -> processInputEasy (parsedGrid, start, end)) allStarts
  return $ minimum results

Note: while this solution for part 2 was the first solution I could think of and took the least additional code to write, we could optimize this part by reversing the search! If we start at the end point and search until we find any a elevation point, we'll solve this with only a single BFS instead of many!

Answering the Question

Nothing more is needed to calculate the final answers! We just parse the input and solve!

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

And we're done with Day 12, and almost halfway there!

Video

YouTube Link!

Advent of Code

James Bowen