I thought day 24 was going to be horrible (given the precedent of 2021 day 24), but it turned out to be one of the simpler puzzles in the past few days, and certainly much easier than the previous search puzzles of day 16 and day 19.
Key idea: cache the blizzards
The key insight into this puzzle is that the blizzards don't care about where the explorer is. Given the elapsed time, the safe positions are completely determined. That meant I could pre-compute the blizzard states for some time period (about 100 for the sample input, about 1000 for the real input), and include them in the puzzle's context while searching.
Data structures
That gave me the data structures I needed. Blizzards are records that know the individual storm's position and direction. I can "compress" that down to a SafeValley, an Array of Bools indicating whether a certain location is safe to be. (I used an Array to ensure fast lookup during the actual search.)
type Position = V2 Int -- x, y
data Blizzard = Blizzard { _positionB :: Position, _headingB :: Position}
deriving (Eq, Ord, Show)
makeLenses ''Blizzard
type SafeValley = Array Position BoolFrom that, a TimedValley is a Map from the time step to the relevant SafeValley, and those get bundled with the start and end positions into the Valley and ValleyContext.
type TimedValley = M.IntMap SafeValley
data Valley = Valley
{ blizzardStates :: TimedValley
, start :: Position
, goal :: Position
} deriving (Eq, Ord, Show)
type ValleyContext = Reader Valley
Finally, the search state is the Explorer, with its position and time.
data Explorer = Explorer
{ _currentPosition :: Position
, _currentTime :: Int
}deriving (Eq, Ord, Show)
makeLenses ''ExplorerReading the map
This was a direct walk over the grid of characters, creating a Blizzard for each arrow in the diagram, and returning a Set of the found Blizzards.
mkInitialMap :: String -> (S.Set Blizzard, (Position, Position))
mkInitialMap text =
( S.fromList [ Blizzard (V2 (x - 1) (y - 1)) (deltaOfArrow $ charAt x y)
| x <- [0..maxX]
, y <- [0..maxY]
, isBlizzard x y
]
, (V2 0 0, V2 (maxX - 1) (maxY - 1))
)
where rows = reverse $ lines text
maxY = length rows - 1
maxX = (length $ head rows) - 1
charAt x y = ((rows !! y) !! x)
isBlizzard x y = (charAt x y) `elem` ("^<>v" :: String)
deltaOfArrow :: Char -> Position
deltaOfArrow '^' = V2 0 1
deltaOfArrow '>' = V2 1 0
deltaOfArrow 'v' = V2 0 -1
deltaOfArrow '<' = V2 -1 0
deltaOfArrow _ = V2 0 0Note that the bounds defined here range from 0 to n, just counting the cells within the valley walls. For the example input, that would be 0 ≤ x ≤ 5 and 0 ≤ y ≤ 4.
Simulating blizzards
Now it's time to put the blizzards into motion.
One Blizzard moves by adding its heading to its position, then wrapping those values into the correct range with mod. Doing all the blizzards is a map over the set of blizzards.
advanceBlizzard :: (Position, Position) -> S.Set Blizzard -> S.Set Blizzard
advanceBlizzard bnds blizzards = S.map (advanceOneBlizzard bnds) blizzards
advanceOneBlizzard :: (Position, Position) -> Blizzard -> Blizzard
advanceOneBlizzard (_, V2 maxX maxY) blizzard = blizzard' & positionB %~ wrap
where wrap (V2 x0 y0) = V2 (x0 `mod` maxX) (y0 `mod` maxY)
blizzard' = blizzard & positionB %~ (^+^ (blizzard ^. headingB))Next is to convert the Set of Blizzards into the Array of safe positions. This array includes the walls (as unsafe places), so has bounds of 0 ≤ x ≤ 7 and 0 ≤ y ≤ 6 for the example valley. Conversion translates the position of each blizzard to this coodinate frame, then adds the walls, but with the gaps for start and end positions. (And there were a few silly mistakes in getting all these coordinates correct!)
toSafe :: (Position, Position) -> S.Set Blizzard -> SafeValley
toSafe (_, V2 maxX maxY) blizzards = accumArray (\_ _ -> False) True bnds' unsafeElements
where unsafeElements = fmap (\i -> (i, False)) $ blizzardLocations ++ walls
blizzardLocations = fmap (^+^ (V2 1 1)) $ fmap (^. positionB) $ S.toList blizzards
walls = left ++ right ++ top ++ bottom
left = range (V2 0 0 , V2 0 (maxY + 1))
right = range (V2 (maxX + 1) 0 , V2 (maxX + 1) (maxY + 1))
top = range (V2 2 (maxY + 1), V2 (maxX + 1) (maxY + 1))
bottom = range (V2 0 0 , V2 (maxX - 1) 0 )
bnds' = (V2 0 0, V2 (maxX + 1) (maxY + 1))I can simulateBlizzards to turn a Set of Blizzards into the TimedValley I need for the search. I iterate the advanceBlizzard function to generate an infinite list of blizzard sets, convert each ot the safe array, zip them with the time stamp, take the few I need, then load them into the Map.
simulateBlizzards :: (Position, Position) -> S.Set Blizzard -> Int -> TimedValley
simulateBlizzards bnds blizzards n =
M.fromList $ take n
$ zip [0..]
$ fmap (toSafe bnds)
$ iterate (advanceBlizzard bnds) blizzardsGiven all that, makeValley puts all the bits together into a Valley, from the initial set of blizzards.
makeValley :: (Position, Position) -> S.Set Blizzard -> Int -> Valley
makeValley bds blizzards n = Valley
{ blizzardStates = bStates
, start = V2 (minX + 1) maxY
, goal = V2 (maxX - 1) minY
}
where bStates = simulateBlizzards bds blizzards n
(V2 minX minY, V2 maxX maxY) = bounds $ bStates M.! 0Finally, here's the showSafe function I used to debug all that fiddling around with coordinates. This was invaluable!
showSafe :: SafeValley -> String
showSafe valley = unlines $ reverse rows
where (V2 minX minY, V2 maxX maxY) = bounds valley
rows = [mkRow y | y <- [minY..maxY]]
mkRow y = [if valley ! (V2 x y) then '.' else '#' | x <- [minX..maxX]]Searching for the route
This was just about the same as day 12, except using the Explorer instead of Position as the search state.
The domain-specific part of the search is finding successors of an explorer. This asks the context for the set of timed blizzards, then selects the one for the next time step. It then finds the positions the explorer could be next (including waiting in place), and checks which of them will be safe (filter (\p -> (blizzards ! p)) ).
successors :: Explorer -> ValleyContext (Q.Seq Explorer)
successors here =
do allBlizzards <- asks blizzardStates
let nextTime = (here ^. currentTime) + 1
let blizzards = allBlizzards M.! nextTime
let bds = bounds blizzards
let pos = here ^. currentPosition
let neighbours =
filter (\p -> (blizzards ! p)) $
filter (inRange bds)
[ pos ^+^ delta
| delta <- [V2 0 0, V2 -1 0, V2 1 0, V2 0 -1, V2 0 1]
]
let succs = Q.fromList
$ fmap (\nbr -> here & currentTime .~ nextTime
& currentPosition .~ nbr )
neighbours
return succsAll that's left is the plumbing to set up and execute the search. runSearch takes the valley to use as context and the time t to start from. searchValley creates the initial agenda then fires off the aStar search process.
part1 :: Valley -> Int
part1 valley = _currentTime $ _current $ fromJust result
where result = runSearch valley 0
runSearch :: Valley -> Int -> Maybe Agendum
runSearch valley t = result
where result = runReader (searchValley t) valley
searchValley :: Int -> ValleyContext (Maybe Agendum)
searchValley t =
do agenda <- initAgenda t
aStar agenda S.empty
initAgenda :: Int -> ValleyContext Agenda
initAgenda t =
do pos <- asks start
let explorer = Explorer pos t
c <- estimateCost explorer
return $ P.singleton c Agendum { _current = explorer, _trail = Q.empty, _trailCost = 0, _cost = c}
Part 2 needs very little more. The fastest way from the start to the end, then back to the start, can be broken down into two independent stages. Given that I can wait at the end for an indefinite time before starting the journey back, I can throw away all other partial routes from start to end once I've found the fastest one. The only wrinkle is to change the positions of start and goal for the return trip.
part2 valley = trip3End
where reverseValley = valley {start = (goal valley), goal = (start valley)}
trip1End = _currentTime $ _current $ fromJust $ runSearch valley 0
trip2End = _currentTime $ _current $ fromJust $ runSearch reverseValley trip1End
trip3End = _currentTime $ _current $ fromJust $ runSearch valley trip2EndCode
You can get the code from my locally-hosted Git repo, or from Gitlab.