Day 15 was a standard graph search, so I reused some old code from day 20 of the 2019 Advent of Code. There are some advantages to doing lots of these!

This program uses several "non-beginner" tools in the code which are worth mentioning.

One is the use of the `lens`

library to tidy up some of the record manipulation steps, such as `candidate = agendum ^. current`

to pull out the `current`

field from the `agendum`

record. It's probably overkill, and I'd probably use Record Wildcards if I were writing this now.

Another is the use of the `Reader`

monad to tidy up the code. Everything in the program depends on the detail of the grid being explored. That means I need to feed that in at the root of the function call tree, but it's only used in a few functions at the leaves of the call tree. Using the `Reader`

allows me to hide some of the plumbing of many functions receiving a *grid* parameter only to pass it unchanged to the functions it calls.

The feature I exploit the most here is type classes. The two parts of today's puzzle differ in how the starting grid and current position are interpreted (with the part 2 grid being several duplicates of the grid in part 1). I could have done that by just building a larger grid and reusing the same code in part 1, or I could use the information in the original to create a "virtual grid" for part 2. Type classes allowed me to do the latter.

## Part 1: A* Search

I won't describe the A* search algorithm here, just show how I implemented it.

I represent the map as an `Array`

of positions, each with an `Int`

cost. There are three flavours of `Position`

used. `BasePosition`

is the position used when reading the input and for locations in the `Grid`

data structures. A `Position`

is the same, but used in part 1. A `TiledPosition`

is a position in the larger, tiled, version of the map. A `TiledPosition`

can be anywhere in the larger, virtual, version of the map. But more on that in a bit. Finally, a `Cave`

is a grid and an explicit goal location and it has a context for the `Reader`

.

```
type BasePosition = V2 Int -- r, c
newtype Position = Position BasePosition -- r, c
deriving (Eq, Ord, Show)
newtype TiledPosition = TiledPosition BasePosition -- r, c
deriving (Eq, Ord, Show)
type Grid = Array BasePosition Int
data Cave = Cave
{ _grid :: Grid
, _goal :: BasePosition
} deriving (Eq, Ord, Show)
makeLenses ''Cave
type CaveContext = Reader Cave
```

The search is controlled by each current solution candidate being an `Agendum`

, and the whole search controlled by the `Agenda`

, a priority queue of `Agendum`

s. I also have a closed set of `ExploredStates`

. Note how these take a type parameter, the type of the current states. In this case, that's either a `Position`

or a `TiledPosition`

.

```
data Agendum s =
Agendum { _current :: s
, _trail :: Q.Seq s
, _trailCost :: Int
, _cost :: Int
} deriving (Show, Eq)
makeLenses ''Agendum
type Agenda s = P.MinPQueue Int (Agendum s)
type ExploredStates s = S.Set s
```

The search algorithm is pretty standard. `runReader`

sets off `searchCave`

in the context of a `cave`

. `aStar`

does the search as described, including checking for reaching the goal, checking for membership of the closed set, and updating the agenda. `candidates`

finds the possible next steps from an `Agendum`

, and `makeAgendum`

converts each candidate into an `Agendum`

.

```
part1 :: Cave -> Int
part1 cave = maybe 0 _cost result
where result = runReader searchCave cave :: Maybe (Agendum Position)
searchCave :: SearchState s => CaveContext (Maybe (Agendum s))
searchCave =
do agenda <- initAgenda
aStar agenda S.empty
initAgenda :: SearchState s => CaveContext (Agenda s)
initAgenda =
do let ss = emptySearchState
c <- estimateCost ss
return $ P.singleton c Agendum { _current = ss, _trail = Q.empty, _trailCost = 0, _cost = c}
aStar :: SearchState s => Agenda s -> ExploredStates s -> CaveContext (Maybe (Agendum s))
aStar agenda closed
-- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined
-- | trace ("Peeping " ++ (show $ _current $ snd $ P.findMin agenda) ) False = undefined
| P.null agenda = return Nothing
| otherwise =
do let (_, currentAgendum) = P.findMin agenda
let reached = currentAgendum ^. current
nexts <- candidates currentAgendum closed
let newAgenda = foldl' (\q a -> P.insert (_cost a) a q) (P.deleteMin agenda) nexts
reachedGoal <- isGoal reached
if reachedGoal
then return (Just currentAgendum)
else if reached `S.member` closed
then aStar (P.deleteMin agenda) closed
else aStar newAgenda (S.insert reached closed)
candidates :: SearchState s => Agendum s -> ExploredStates s -> CaveContext (Q.Seq (Agendum s))
candidates agendum closed =
do let candidate = agendum ^. current
let previous = agendum ^. trail
let prevCost = agendum ^. trailCost
succs <- successors candidate
let nonloops = Q.filter (\s -> s `S.notMember` closed) succs
mapM (makeAgendum previous prevCost) nonloops
makeAgendum :: SearchState s => (Q.Seq s) -> Int -> s -> CaveContext (Agendum s)
makeAgendum previous prevCost newPosition =
do predicted <- estimateCost newPosition
grid <- asks _grid
let newTrail = previous |> newPosition
newPositionCost <- entryCost newPosition
let incurred = prevCost + newPositionCost
return Agendum { _current = newPosition
, _trail = newTrail
, _trailCost = incurred
, _cost = incurred + predicted
}
```

You'll notice that these functions don't look at any specifics of the grid itself, using functions like `successors`

and `entryCost`

to do that.

## Part 2: Polymorphism

Those grid-specific details are handled by functions in the `SearchState`

class.

```
class (Eq s, Ord s, Show s) => SearchState s where
unwrapPos :: s -> BasePosition
emptySearchState :: s
successors :: s -> CaveContext (Q.Seq s)
estimateCost :: s -> CaveContext Int
isGoal :: s -> CaveContext Bool
entryCost :: s -> CaveContext Int
instance SearchState Position where
...
instance SearchState TiledPosition where
...
```

Each `SeachState`

type, `Position`

and `TiledPosition`

, has its own version of these functions. Haskell uses the concrete type to determine which function to use.

When I solved part 2, I kept the underlying grid the same, but mapped the position in the tiled version of the map to the correct position in the underlying grid. For instance, the `entryCost`

function returns the cost to enter a position.

```
entryCost (TiledPosition (V2 r c)) =
do grid <- asks _grid
let (_, V2 maxR maxC) = bounds grid
let (tileR, gridR) = r `divMod` (maxR + 1)
let (tileC, gridC) = c `divMod` (maxC + 1)
let gridCost = grid ! (V2 gridR gridC)
let !cost = (gridCost - 1 + tileR + tileC) `mod` 9 + 1
return cost
```

This function works out which tile the position is in, and where in that tile, and uses that to calculate the updated cost.

## Profiling

The last thing to cover is the profiling. My original version of the code for part 2 took about two minutes to run.

I profiled the runtime of the program and found that `entryCost`

was taking about 50% of the runtime, with another 40% in `makeAgendum`

. A little bit of thinking showed why. My original version of the `Agendum`

record was this:

```
data Agendum s =
Agendum { _current :: s
, _trail :: Q.Seq s
, _cost :: Int
} deriving (Show, Eq)
```

where `_cost`

is the estimated total cost and the incurred cost was recalculated from the* *`_trail`

every time a new `Agendum`

was created. That led to a lot of lookups in the grid! A small change to `Agendum`

(to retain the incurred trail cost) and suddenly the runtime dropped from two minutes to under five seconds.

You can see the original version as `advent15/src/MainSlow.hs`

.

## Code

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