Advent of Code 2024 day 10

Day 10 was one where I out-thought myself. I guessed what part 2 would be, and guessed wrong. That meant my initial solution to part 1 was vastly more complicated than it need be. Once I saw part 2, I was able to simplify things a lot to the state you see below.

Fundamentally, the problem is one of graph search, using the graph of possible "steps" defined by the input map.

My guess about part 2 is that it would change the rules about allowed steps in the map, such as allowing the trail to go downhill slightly as well as uphill. That prompted me to resurrect my solution to 2023 day 17 and use that as the basis for my solution. How wrong I was!

Once you know about part 2, it's clear that the solution to part 1 is just the abstraction of some information from the solution to part 2. Therefore, I solve part 2 first, then use that to give the answer to part 1.

Representation

It's a bit excessive, but I have explicit data types for the grid (an Array), the map as a whole (a record of the map and the start and goal positions), and the search agenda (a record of current position and the trail to get there). I wrap the whole lot in a Reader monad to avoid passing the map around all the various functions.

type Position = V2 Int -- r, c

type Trail = [Position]

type Grid = Array Position Int

data TMap = TMap
  { grid :: Grid
  , starts :: [Position]
  , goals :: [Position]
  } deriving (Show)

type TMapContext = Reader TMap

data Agendum = 
    Agendum { current :: Position
            , trail :: Trail
            } deriving (Show, Eq)

type Agenda = [Agendum]

Building the map is the now-standard input process.

mkMap :: String -> TMap
mkMap text = TMap { .. }
  where rows = lines text
        r = length rows - 1
        c = (length $ head rows) - 1
        grid = listArray ((V2 0 0), (V2 r c)) $ map readElem $ concat rows
        readElem x = if isDigit x then digitToInt x else -1
        starts = [ V2 ra ca | ra <- [0..r], ca <- [0..c], rows !! ra !! ca == '0' ]
        goals = [ V2 ra ca | ra <- [0..r], ca <- [0..c], rows !! ra !! ca == '9' ]

Searching

Looking for trails is a breadth-first search from a starting position, returning all the goals found from that start. It's controlled by an agenda of partial trails. Each step of the search takes the first item off the agenda, extends that trail, and puts the partial trails back on the agenda. When it finds a solution, it adds it to the accumulator of found trails.

bfs ::  Agenda -> [Agendum] -> TMapContext [Agendum]
bfs [] founds = return founds
bfs (currentAgendum : restAgenda) founds = 
  do  let reached = currentAgendum.current
      nexts <- candidates currentAgendum 
      let newAgenda = restAgenda ++ nexts
      reachedGoal <- isGoal reached
      if reachedGoal
      then bfs restAgenda (currentAgendum : founds)
      else bfs newAgenda founds

The search is slightly unusual in not having a closed set of previously-visited positions. That's a standard optimisation in search, to avoid doing repeated work. However, the part 2 definition explicitly asks us to find those routes that may visit previously-visited nodes.

There are a few functions of plumbing to connect agendas to new agenda, but the business of finding the route is handled by successors. This returns a list of positions reachable from the current one.

successors :: Position -> TMapContext [Position]
successors here = 
  do  g <- asks grid
      let height = (g ! here) + 1
      let moves = [ here ^+^ delta
                  | delta <- [ V2 (-1) 0, V2 1 0, V2 0 (-1), V2 0 1 ]
                  ]
      let boundMoves = filter (inRange (bounds g)) moves
      let validMoves = filter (\m -> g ! m == height) boundMoves
      return validMoves

The whole thing is kicked off by searchMap. See the code for the other bits of plumbing.

searchMap :: Position -> TMapContext [Agendum]
searchMap startPos = 
  do agenda <- initAgenda startPos
     bfs agenda []

Then I can find all the possible routes across the map.

allTrails = fmap (allRoutesFrom tmap) trailheads

allRoutesFrom :: TMap -> Position -> [Agendum]
allRoutesFrom tmap s = runReader (searchMap s) tmap

allTrails is a list of list of trails; one outer list for each start, one member of each inner list for each distinct route.

Solving

Given allTrails, part 2 is the number of distinct trails. For part 1, I have to find the distinct goals from each trail start, and add those up.

part1, part2 :: [[Agendum]] -> Int
part1 trails = sum $ fmap length $ fmap dedupe trails
    where dedupe solns = nub $ fmap current solns

part2 trails = sum $ fmap length trails

Code

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