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. `Blizzard`

s are records that know the individual storm's position and direction. I can "compress" that down to a `SafeValley`

, an `Array`

of `Bool`

s 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)
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 ''Explorer
```

## Reading 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 `Blizzard`

s.

```
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 `Blizzard`

s 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 `Blizzard`

s 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 =
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 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 =
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 trip2End
```

## Code

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