Advent of Code 2024 day 16

For day 16, I started out with an experiment. It was successful, but a dead-end when it came to part 2.

Data types

I defined a couple of data types to store the maze.

type Position = V2 Int -- r, c

data Direction = N | E | S | W deriving (Show, Eq, Ord)
data Reindeer = Reindeer { pos :: Position, dir :: Direction } 
  deriving (Show, Eq, Ord)
type Walls = S.Set Position

Reading the maze was a standard grid read.

mkMaze :: String -> Maze
mkMaze text = Maze { walls = walls, start = start, goal = goal }
  where rows = lines text
        rMax = length rows - 1
        cMax = (length $ head rows) - 1
        walls = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '#' ]
        start = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'S' ]
        goal = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'E' ]

I also defined a couple of utility functions.

delta :: Direction -> Position
delta N = V2 (-1) 0
delta S = V2 1 0
delta W = V2 0 (-1)
delta E = V2 0 1

turnDirections :: Direction -> [Direction]
turnDirections N = [E, W]
turnDirections S = [E, W]
turnDirections E = [N, S]
turnDirections W = [N, S]

Part 1

I've had the Algorithm.Search library on my horizon for a while, as something that would be better for writing search routines. I thought I'd give it a try today.

For an A* search, I have to define four functions: one that gives the costed neighbours of a search state, the estimated cost to complete from a particular state, a predicate to detect goal states, and a function to generate an initial state. These all followed the problem definition.

neighbours :: Maze -> Reindeer -> [(Reindeer, Int)]
neighbours maze reindeer 
  | wallAhead = turns
  | otherwise = (ahead, 1) : turns
  where ahead = reindeer { pos = reindeer.pos ^+^ delta (reindeer.dir) }
        wallAhead = ahead.pos `S.member` maze.walls
        turns = [ (reindeer { dir = d }, 1000) 
                | d <- turnDirections (reindeer.dir) ]

isGoal :: Maze -> Reindeer -> Bool
isGoal maze r = maze.goal == r.pos

estimateCost :: Maze -> Reindeer -> Int
estimateCost maze r = (abs dr) + (abs dc)
  where (V2 dr dc) = r.pos ^-^ maze.goal

initial :: Maze -> Reindeer
initial maze = Reindeer { pos = maze.start, dir = E }

Doing the search was as simple as calling the aStarAssocs function, with these functions passed in.

part1 maze = fst $ fromJust path
  where path = aStarAssoc (neighbours maze) 
                          (estimateCost maze) 
                          (isGoal maze) 
                          (initial maze)

And that was it! It worked fine. Something to note for future.

Part 2

Unfortunately, that approach doesn't work for part 2. Rather than finding a route, I have to find all routes, in the same way as day 10. That meant I had to build my own best-first search. This version does have a closed set, but the set is of Reindeer, not Position, as arriving at the same place but facing a different way leads to different ongoing costs.

type Trail = [Reindeer]
type Closed = S.Set Reindeer

data Maze = Maze
  { walls :: Walls
  , start :: Position
  , goal :: Position
  } deriving (Eq, Ord, Show)

type MazeContext = Reader Maze

data Agendum = 
    Agendum { current :: Reindeer
            , trail :: Trail
            , cost :: Int
            } deriving (Show, Eq)

type Agenda = [Agendum]

The core of the search is the bfs function, that maintains the agenda of partial paths, the closed set, and the best of the complete paths. Note that I sort the agenda based on incurred cost.

bfs ::  Agenda -> Closed -> [Agendum] -> MazeContext [Agendum]
bfs [] _ founds = return founds
bfs (currentAgendum : restAgenda) closed founds = 
  do  let reached = currentAgendum.current
      nexts <- candidates currentAgendum closed
      let newAgenda = if viable currentAgendum founds
                      then sortOn cost $ restAgenda ++ nexts
                      else restAgenda
      reachedGoal <- isGoal reached
      let founds' = if reachedGoal
                    then updateFounds currentAgendum founds
                    else founds
      bfs newAgenda (S.insert reached closed) founds'

viable prunes partial routes that are already longer than the best route found. updateFounds handles keeping track of just the best paths.

viable :: Agendum -> [Agendum] -> Bool
viable _ [] = True
viable agendum (f:_) = agendum.cost <= f.cost

updateFounds :: Agendum -> [Agendum] -> [Agendum]
updateFounds agendum [] = [agendum]
updateFounds agendum founds@(f:_)
  | agendum.cost < f.cost = [agendum]
  | agendum.cost == f.cost = agendum : founds
  | otherwise = founds

searchMaze and initAgenda kick things off. Note the inclusion of the initial Reindeer in the trail. This solves a nasty off-by-one error!

searchMaze :: MazeContext [Agendum]
searchMaze = 
  do agenda <- initAgenda
     bfs agenda S.empty []

initAgenda :: MazeContext Agenda
initAgenda = 
    do s <- asks start 
       let r0 = Reindeer { pos = s, dir = E}
       let agendum = Agendum { current = r0
                             , trail = [r0]
                             , cost = 0
                             }
       return [agendum]

Finally, candidates and makeAgendum do the plumbing for the updates.

candidates :: Agendum -> Closed -> MazeContext [Agendum]
candidates agendum closed = 
  do  let here = agendum.current
      succs <- successors here
      let viableSuccs = filter (\(r, _) -> not $ r `S.member` closed) succs
      mapM (makeAgendum agendum.trail agendum.cost) viableSuccs 

makeAgendum :: Trail -> Int -> (Reindeer, Int) -> MazeContext Agendum
makeAgendum previous pCost (here, stepCost) = 
    do let newTrail = (here : previous)
       return Agendum { current = here
                      , trail = newTrail
                      , cost = pCost + stepCost
                      }

Addendum: optimisation

This solution took about 25 seconds to run. I converted the agenda from a list to a priority queue and that reduced the runtime by almost two orders of magnitude to 0.3 seconds. See the optimisation blog post for details.

Code

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