advent of code, haskell

Advent of Code 2024 day 20

I got lucky in day 20. I made an optimisation to solve part 1 quickly, and that made part 2 very easy.

Overall, the task is pathfinding again, but with a twist that you can burrow through some walls in the maze. I need to find all the sections that give a large saving over the path without any burrowing.

The obvious way to do this is

  • for each wall section:
    • remove it
    • find the shortest path

That would work, but is likely to take some time. Finding a short path is quick, but not free, and there are a lot of wall sections to check. I didn't bother implementing this. Time for a better approach.

I took inspiration from how Dijkstra's shortest-path algorithm works. That algorithm fills out a table of shortest distance from the start to each position, working out in a breadth-first manner. If I have that table, and one giving the distance from each position to the goal, I can easily work out the distance of a path with burrowing. When I ask the agent to burrow through a wall, the cost of the path is the cost from the start to this side of the wall, plus the cost from the end to that side of the wall, plus the cost to move from one side to the other.

Data structures

The track is a record, holding the positions of the walls and the position of the start and end. The costs for each position are stored in a Map, giving the cost of each position from a particular point. 

type Position = V2 Int -- r, c

type Walls = S.Set Position

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

type TrackCost = M.Map Position Int

Reading the map is a walk over the input text.

mkTrack :: String -> Track
mkTrack text = Track { 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' ]

Finding costs

The core of the solution is to pre-process the track to find all the costs from a position to the start and the end. That's done by costsFrom, called once for the start position and the end end position. It works by breadth-first exploration of the track, maintaining a boundary of positions to process. Note that M.union only adds new items if they're not already in the costs. 

costsFrom :: Track -> TrackCost -> TrackCost -> TrackCost
costsFrom track costs boundary
  | M.null boundary = costs
  | otherwise = costsFrom track costs' boundary''
  where boundary' = M.foldlWithKey addBoundary M.empty boundary
        addBoundary acc here cost = 
          M.union acc $ M.fromList $ zip (neighbours track here) (repeat (cost + 1))
        boundary'' = boundary' `M.difference` costs
        costs' = costs `M.union` boundary'

neighbours :: Track -> Position -> [Position]
neighbours track here = 
  filter (`S.notMember` track.walls) 
          [ here ^+^ V2 0 1, here ^+^ V2 0 (-1), 
            here ^+^ V2 1 0, here ^+^ V2 (-1) 0 ]

Finding cheats

For part 1, the allowable cheat is just enough to get through a one-space-thick wall. That means I can find all the possible cheats by eliminating each wall position in turn and finding the revised cost. (I only need the costs, not the position of the removed wall as well.)

allCheatedCosts track costsFromStart costsFromGoal = 
  catMaybes [ pathCostWithCheat track costsFromStart costsFromGoal h 
            | h <- S.toList track.walls 
            ]

pathCostWithCheat uses the two tables of costs to find the cost after removing a particular wall. It looks up the neighbours of the removed wall section and, if there's at least one of each, it returns the cost as the two half-costs plus the two steps to move through the wall. Note that this returns a Maybe Int, in case the removed section isn't connected to the start or the end.

pathCostWithCheat :: Track -> TrackCost -> TrackCost -> Position -> Maybe Int
pathCostWithCheat track costsFromStart costsFromGoal here 
  | (not $ null costsToStart) && (not $ null costsToGoal) = Just $ minimum costsToStart + minimum costsToGoal + 2
  | otherwise = Nothing
  where
    nbrs = neighbours track here
    costsToStart = catMaybes $ fmap (`M.lookup` costsFromStart) nbrs
    costsToGoal  = catMaybes $ fmap (`M.lookup` costsFromGoal)  nbrs

With allCheatedCosts, the overall solution writes itself.

part1 track costsFromStart costsFromGoal = length savings
  where fullCost = costsFromStart M.! track.goal
        cheatCosts = allCheatedCosts track costsFromStart costsFromGoal
        savings = filter (>= 100) $ fmap (\c -> fullCost - c) cheatCosts

You'll also notice the findSavings function, which I used for debugging.

Part 2

Part 2 changes the rules, but not in a way that really changes what I do. Now, the amount of cheating can increase, but the precise details of what happens during the cheating aren't important.

That means the path-with-cheating still has three sections: the normal path to the start of the cheating section, the cheating section, and the normal path from the end of the cheating section to the goal. The cost of each cheating section is the distance travelled; the cost of the normal sections, I look up as before.

That means pathCostWithCheat changes. I pass in the maximum length of the cheating section and where the cheating starts, and it returns the updated length for all distinct starts-and-ends of the cheating section. I try all cheating-ends that are within range of here, some of which may not be legal. 

pathCostWithCheat :: Int -> Track -> TrackCost -> TrackCost -> Position -> [Int]
pathCostWithCheat cheatLen track costsFromStart costsFromGoal here =
  fmap (+ costsFromStart M.! here) continueCosts 
  where
    nbrs =  [ here ^+^ (V2 dr dc) 
            | dr <- [-cheatLen .. cheatLen]
            , dc <- [-cheatLen .. cheatLen]
            , abs dr + abs dc <= cheatLen
            ]
    continueCosts = catMaybes $ fmap contCost nbrs
    contCost :: Position -> Maybe Int
    contCost nbr = do gc <- M.lookup nbr costsFromGoal
                      let sc = l2Dist nbr here
                      return $ gc + sc

l2Dist :: Position -> Position -> Int
l2Dist (V2 r1 c1) (V2 r2 c2) = abs (r1 - r2) + abs (c1 - c2)

allCheatedCosts changes slightly to account for the changed type of pathCostWithCheat.

allCheatedCosts :: Int -> Track -> TrackCost -> TrackCost -> [Int]
allCheatedCosts cheatLen track costsFromStart costsFromGoal = 
  concat [ pathCostWithCheat cheatLen track costsFromStart costsFromGoal h 
            | h <- M.keys costsFromStart 
            ]

I refactored the overall calculation into a new function, bigSavings, and called the same function with different parameters to solve both parts.

part1, part2 :: Track -> TrackCost -> TrackCost -> Int
part1 = bigSavings  2 100
part2 = bigSavings 20 100

bigSavings :: Int -> Int -> Track -> TrackCost -> TrackCost -> Int
bigSavings cheatLen savingThreshold track costsFromStart costsFromGoal = length savings
  where fullCost = costsFromStart M.! track.goal
        cheatCosts = allCheatedCosts cheatLen track costsFromStart costsFromGoal
        savings = filter (>= savingThreshold) $ fmap (\c -> fullCost - c) cheatCosts

Code

You can get the code from my locally-hosted Git repo, or from Codeberg. The code for part 1 was modified for part 2; you can find the part 1 only version in an earlier commit.