Advent of Code 2024 day 18

Day 18 was an odd one. It should have been much quicker but for me finding an odd issue in the library I was using.

Data representation

The main thing I defined was a representation of the whole space, a record called Memory. I named a couple of other things as well, and hard-coded the size of the memory.

type Position = V2 Int -- x, y

type Corrupted = S.Set Position

data Memory = Memory
  { corrupted :: Corrupted
  , start :: Position
  , goal :: Position
  } deriving (Eq, Ord, Show)

type Explorer = Position

memoryBounds :: (Position, Position)
memoryBounds = (V2 0 0, V2 70 70)

Part 1

I had another go at using the search-algorithms library, rather than rolling my own. This needed definition of a few functions to define the search space. The only interesting one was neighbours.

neighbours :: Memory -> Explorer -> [Explorer]
neighbours memory explorer = 
  filter (`S.notMember` memory.corrupted) $
  filter (inRange memoryBounds) 
    [ explorer ^+^ d
    | d <- [V2 0 1, V2 1 0, V2 0 (-1), V2 (-1) 0]
    ]

Then I needed to do the search.

part1 :: [Position] -> Int
part1 bytes = fst $ fromJust path
  where path = aStar (neighbours memory) 
                      (transitionCost)
                      (estimateCost memory) 
                      (isGoal memory) 
                      (initial memory)
        memory = Memory (S.fromList $ take 1024 bytes) 
                        (fst memoryBounds) (snd memoryBounds)

Part 2

For this, I needed to walk along the input list, detecting of the puzzle was solvable as I went. That's the general shape of a fold, but the need to examine intermediate values meant I used a scan.

As I walk along the list, I build up an accumulator of the corrupted bytes handled so far. At each step, I check if a solution is possible. If it is, I drop it form the list of results. When I find a set of bytes that don't admit a solution, I pick out the most recent item added to the accumulator. I save a little bit of work by skipping the first 1024 tests.

part2 :: [Position] -> String
part2 bytes = showResult $ head $ snd $ head results
  where 
    (goods, poss) = splitAt 1024 bytes
    results = dropWhile ((== True) . fst) $ scanl' go (True, goods) poss
    go (_, acc) byte = (escapePossible (byte : acc), (byte : acc))
    showResult (V2 x y) = show x ++ "," ++ show y

That needs escapePossible to be defined. It's pretty much the same as the part 1 solution.

escapePossible :: [Position] -> Bool
escapePossible bytes = isJust path
  where 
    memory = Memory (S.fromList bytes) (fst memoryBounds) (snd memoryBounds)
    path = aStar (neighbours memory) 
                  (transitionCost)
                  (estimateCost memory) 
                  (isGoal memory) 
                  (initial memory)

The issue

That would have been it, except for an issue that came up while using the search-algorithms library I found. Given that the puzzle had the memory gaining obstacles over time, I anticipated that the part 2 solution would need to know the time taken to get to various positions.

That prompted me to define Explorer as a record of position and current time:

data Explorer = Explorer
  { pos :: Position
  , ct :: Int
  } 
  deriving (Eq, Ord, Show)

I made the obvious changes to neighbours and the like to accommodate this.

It didn't work. When there was no path from start to goal, the aStar search didn't report that. Instead, it consumed a lot of memory and crashed. I spent ages poking around to understand the problem.

It turns out, it's an issue with with Explorer records are compared. If I compare them solely on position, everything works fine. If I compare them on the combination of position and time, search hangs. When I create custom Eq and Ord instances that rely just on position, it works.

instance Eq Explorer where
  e1 == e2 = pos e1 == pos e2
  
instance Ord Explorer where
  compare e1 e2 = compare (pos e1) (pos e2)

Thanks to @fizbin.bsky.social for pointing this out.

Addendum: optimisation

This version takes about twenty seconds to run. This is because it does many thousands to route-finding searches, one per obstacle that falls, searching for the obstacle that blocks all routes. When I convert that linear search to using a binary search, the run time drops by a couple of orders of magnitude to under a quarter of a second. See the blog post where I describe the optimisation.

Code

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