Advent of Code 2023 day 08

Day 8 was the first example of a "reverse-engineering" puzzle; I'm not a fan of this sort of puzzle, with a clever trick to discover.

Part 1

This wasn't too bad. Directions were a new data type. I decided to represent the map as, well, a Map from the node name to the pair of successor nodes. When exploring the map, I needed to know both where I was and how many steps I'd taken; those were the State type.

data Direction = L | R deriving (Show, Eq)
data Node = Node String String deriving (Show)
type Desert = M.Map String Node

data State = State { getHere :: String, getSteps :: Int } deriving (Eq, Show)
instance Ord State where
  compare (State n1 s1) (State n2 s2) = compare (s1, n1) (s2, n2)

Reading the data was a fairly direct translation.

problemP = (,) <$> ((many1 directionP) <* many1 endOfLine) <*> desertP
directionP = (L <$ "L") <|> (R <$ "R")

desertP = M.fromList <$> desertLineP `sepBy` endOfLine
desertLineP = (,) <$> (nameP <* " = ") <*> nodeP

nodeP = Node <$> ("(" *> nameP <* ", ") <*> (nameP <* ")")
nameP = many1 (letter <|> digit) 

Exploring the map involves taking a list of Directions and combining them into a State. That's the shape of a fold, but I need the intermediate results. That means I base the exploration around the use of scanl'.

One step of the journey finds the Node in the desert, picks the appropriate successor, and bundles it all up into a new State. walk uses scanl' to take many steps, ending when the current state is a goal state.

walk :: Desert -> [Direction] -> State -> State
walk desert directions start = head $ dropWhile (not . isGoal) path
  where path = scanl' (step desert) start $ drop offset $ cycle directions
        offset = (getSteps start) `mod` (length directions)
  
step :: Desert -> State -> Direction -> State
step desert (State here steps) direction
  | direction == L = State thereL (steps + 1)
  | direction == R = State thereR (steps + 1)
  where
    (Node thereL thereR) = desert ! here
    
isGoal :: State -> Bool
isGoal (State here _) = (last here) == 'Z'

The part 1 solution is to find the length of the walk from "AAA".

part1 :: Desert -> [Direction] -> Int
part1 desert directions = getSteps $ walk desert directions (State "AAA" 0)

Part 2

This is where I stopped having fun.

My first attempt was just to fire off a bunch of different walks, and keep them in a list ordered by the number of steps. If all the walks are at goals, and all have the same number of steps, announce success. Otherwise, pick the earliest walk, advance it to the next goal position, and try again.

This didn't work: it took too long.

I then moved on to some form of pre-processing. Could I find, for each position in the desert, how long it would take to get to a goal? But that value depends both on where you start and the time you start (as that changes the directions you follow). For my input that was about 280 × 740 = 207,000 possible combinations to explore. A few, but not too bad.

A quick inspection of the sample inputs showed one problem with this approach: there were a few infinite loops of non-goal nodes. I could either work on filtering these out, or I could do something a bit different.

The "a bit different" was to memoise the exploration. Every time I came across a new combination of <start position, start time> I would add it to the cache, then follow the do-some-walks,-update-the-shortest approach I outlined above.

That also took too long, but it's worth looking at how I did it.

I used another Map to store the cache, this one going from the <position, time> data to the <position, duration> of the resulting walk.

data PathStart = PathStart String Int deriving (Eq, Ord, Show)
data CollapsedPath = CPath String Int deriving (Show)
type Paths = M.Map PathStart CollapsedPath

walkWithCache used the cache to short-circuit repeated journeys, and added to the cache as needed.

walkWithCache :: Desert -> [Direction] -> Paths -> State -> (State, Paths)
walkWithCache desert directions cache start =
  case cacheEntry of
    Just (CPath there steps) -> (State there (steps + (getSteps start)), cache)
    Nothing -> (newState, newCache)
  where offset = (getSteps start) `mod` (length directions)
        cacheEntry = cache !? (PathStart (getHere start) offset)
        start' = step desert start (directions !! offset)
        newState = walk desert directions start'
        newCache = M.insert (PathStart (getHere start) offset) 
                            (CPath (getHere newState) ((getSteps newState) - (getSteps start)))
                            cache

multiWalk handles all the walks. There's a list of States to explore, sorted so the earliest one is first.

multiWalk desert directions cache states@(s:ss)
  | (all isGoal states) && (sameTime states) = states
  | otherwise = multiWalk desert directions newCache $ sort (s':ss)
  where (s', newCache) = walkWithCache desert directions cache s

sameTime states = (length $ nub times) == 1
  where times = fmap getSteps states

This worked, generating the correct result after about two hours of runtime. But it was obviously the wrong track.

At this point, I realised that life was too short and popped over to the Reddit thread to find the trick. It turns out that the map is designed so that each path from start to goal, and from goal to another goal, takes exactly a multiple of the number of directions. That means that all the paths effectively start at time 0. Therefore, the time for all the paths to synchronise is the least common multiple of the path lengths.

I confirmed that by generating the routes for my input, using generateRouteLengths

generateRouteLengths :: Desert -> [Direction] -> Paths
generateRouteLengths desert directions = M.unions ((fmap snd sResults) ++ (fmap snd gResults))
  where starts = sort $ fmap (\s -> State s 0) $ startsOf desert
        sResults = fmap (walkWithCache desert directions M.empty) starts
        fromGoals = fmap fst sResults
        gResults = fmap (walkWithCache desert directions M.empty) fromGoals

That gave this output (re-sorted):

fromList [
(PathStart "AAA" 0,CPath "ZZZ" 13207),
(PathStart "FBA" 0,CPath "LDZ" 22199),
(PathStart "PRA" 0,CPath "KJZ" 19951),
(PathStart "PTA" 0,CPath "XTZ" 20513),
(PathStart "PVA" 0,CPath "XVZ" 14893),
(PathStart "XLA" 0,CPath "SCZ" 12083),
(PathStart "KJZ" 0,CPath "KJZ" 19951),
(PathStart "LDZ" 0,CPath "LDZ" 22199),
(PathStart "SCZ" 0,CPath "SCZ" 12083),
(PathStart "XTZ" 0,CPath "XTZ" 20513),
(PathStart "XVZ" 0,CPath "XVZ" 14893),
(PathStart "ZZZ" 0,CPath "ZZZ" 13207)]

...with 281 instructions in the input file. All of the path lengths are divisible by 281, so the final time is just the LCM of them.

part2 desert directions = foldl1 lcm pathLens
  where cache = generateRouteLengths desert directions
        pathLens = fmap (\(CPath _ l) -> l) $ M.elems cache

Code

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