Advent of Code 2022 day 24

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 Bool

From 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)



Finally, the search state is the Explorer, with its position and time.

data Explorer = Explorer
{ _currentPosition :: Position
, _currentTime :: Int
}deriving (Eq, Ord, Show)
makeLenses ''Explorer

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 0 Note 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) blizzards

Given 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.! 0 Finally, 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 =
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 succs

All 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 =
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 trip2End