Advent of Code 2022 day 12

Day 12 was another old favourite: A* search. This solution was based heavily on the solution to 2021 day 15.

That older solution contains a description of the implementation of A* search so I won't repeat it here. I'll just point out the problem-specific elements.

I represent the "mountain" height-map as a grid, an Array of heights along with the start and end positions. I also show how to put this in a Reader monad to hide the plumbing of this read-only data through the search.

type Position = V2 Int -- r, c
type Grid = Array Position Int

data Mountain = Mountain
  { _grid :: Grid
  , _start :: Position
  , _goal :: Position
  } deriving (Eq, Ord, Show)
makeLenses ''Mountain

type MountainContext = Reader Mountain

Making the grid is mostly reading the the characters, then updating the specified start and end positions.

mkMountain :: String -> Mountain
mkMountain text = Mountain { _grid = grid, _start = s, _goal = g }
  where rows = lines text
        r = length rows - 1
        c = (length $ head rows) - 1
        grid0 = listArray ((V2 0 0), (V2 r c)) $ map mkCell $ concat rows
        mkCell e = ord e - ord 'a'
        s = head [i | i <- range ((V2 0 0), (V2 r c)), grid0 ! i == (mkCell 'S')]
        g = head [i | i <- range ((V2 0 0), (V2 r c)), grid0 ! i == (mkCell 'E')]
        grid = grid0 // [(s, mkCell 'a'), (g, mkCell 'z')]

The reachable neighbours of a position are defined according to the the problem spec: horizontally and vertically adjacent, no more than one higher. This uses the inRange function of the grid's index to keep the possible successors as valid positions.

successors :: Position -> MountainContext (Q.Seq Position)
successors here = 
  do grid <- asks _grid
     let heightHere = grid ! here
     let neighbours = 
          filter (\p -> (grid ! p) - heightHere <= 1)
          $ 
          filter (inRange (bounds grid))  
            [ here ^+^ delta
            | delta <- [V2 -1 0, V2 1 0, V2 0 -1, V2 0 1]
            ]
     let succs = Q.fromList neighbours
     return succs

The heuristic for guiding search is the Manhattan distance from the current position to the goal.

estimateCost :: Position -> MountainContext Int
estimateCost here = 
  do goal <- asks _goal
     let (V2 dr dc) = here ^-^ goal
     return $ (abs dr) + (abs dc)

Solving the problem

Part 1 was standard search.

part1, part2 :: Mountain -> Int
part1 mountain = maybe 0 _cost result
    where s = mountain ^. start
          result = runReader (searchMountain s) mountain

runSearch :: Mountain -> Position -> Int
runSearch mountain s = maybe maxCost _cost result
  where result = runReader (searchMountain s) mountain
        maxCost = length $ indices $ mountain ^. grid

Part 2 was doing many searches, from each possible starting position.

part2 mountain = minimum results
  where starts = possibleStarts mountain
        results = fmap (runSearch mountain) starts

possibleStarts :: Mountain -> [Position]
possibleStarts mountain = map fst $ filter ((== 0) . snd) 
                                  $ assocs $ mountain ^. grid

Code

You can get the code from my locally-hosted Git repo, or from Gitlab.