Day 17 got a lot simpler when I stopped trying to be clever and just wrote down what was in the specification. By doing that, I could make sure that illegal states (i.e. illegal moves) couldn't be generated, rather than generating possibly-illegal moves then filtering them out. (My first attempt was all about stepping through the grid and looking to see if the previous few positions were in a straight line or not, and that meant I got tied up in knots when it came to part 2.)

My approach is to find the moves of the crucible, and track the movement of the crucible through the city as a sequence of those moves. For example, the sample solution given the part 1 specification would be "right 2, down 1, right 3, up 1, …"

Representation and low-level building blocks

To that end, some definitions. A Position is a row-column pair. A Direction is up, down, left, or right. A Move has a Direction and a number of steps. A Trail is a sequence of Moves. A DirectedPosition is the pair of Direction and Position: I use that to track repeated states. (If I arrive at the same place but from a different direction, the situations have different successor states.) A Grid is an Array of heat losses, indexed by Position. The ExploredStates is a set of DirectedPosition.

type Position = V2 Int -- r, c
_r :: Lens' (V2 Int) Int
_r = _x
_c :: Lens' (V2 Int) Int
_c = _y

data Direction = U | D | L | R deriving (Show, Eq, Ord)
data Move = Move Direction Int deriving (Show, Eq, Ord)

type Trail = Q.Seq Move

type DirectedPosition = (Direction, Position)

type Grid = Array Position Int

type ExploredStates = S.Set DirectedPosition

I need a few low-level functions for handling Moves and Directions. The delta of a direction is the change in position from moving in that direction. I can convert a Move toPositions if I know the move and where it starts. I can also find the DirectedPosition at the end of a move.

delta :: Direction -> Position
delta U = V2 (-1) 0
delta D = V2 1 0
delta L = V2 0 (-1)
delta R = V2 0 1

toPositions :: Position -> Move -> [Position]
toPositions here (Move dir n) = [ here ^+^ (d ^* i) | i <- [1..n] ]
  where d = delta dir

endingDirPos :: Position -> Move -> DirectedPosition
endingDirPos here move@(Move dir _) = (dir, last $ toPositions here move)

For generating new moves, I need to know the possible next directions after moving in a given direction. I also need to check that all the positions in a move are within the grid.

turnDirections :: Direction -> [Direction]
turnDirections U = [L, R]
turnDirections D = [L, R]
turnDirections L = [U, D]
turnDirections R = [U, D]

allInBounds :: (Position, Position) -> Position -> Move -> Bool
allInBounds bounds here move = all (inRange bounds) $ toPositions here move

I can put all that together in the functions successorsWithRange. This takes a DirectedPosition and a range of move lengths, and returns a Sequence of possible moves.

successorsWithRange :: (Int, Int) -> DirectedPosition -> CityContext (Q.Seq Move)
successorsWithRange rng (dir, here) =
  do  grid <- asks _grid
      let moves = [ Move d n 
                  | d <- turnDirections dir
                  , n <- range rng
                  ]
      let validMoves = filter (allInBounds (bounds grid) here) moves
      return $ Q.fromList validMoves

Finding the best path

This is a graph search algorithm, so I dusted off my standard A* search implementation, as described in the post on Advent of Code 2021 day 15. As in that case, I used typeclasses to handle the differences between parts 1 and 2. The typeclass mechanism allows the inner workings of the algorithm to change while using the same implmentation for the bits that aren't affected. You can look at the details in the 2021 post or in the code (linked below).

What makes this implementation a bit different is that the data structures used in the two parts are identical. The only difference is that the successors function  needed to change between the two parts. My previous uses of typeclasses for this was when the definition of the "current state" was different, which allowed me to include that state as a type-level variable in the code.

For this example, I used phantom types (see the good explanation by Steven Levia).

I created two new types, without constructors. These represent the two types of crucible. The Agendum and Agenda types take a type parameter (for the type of crucible) even though it's not used in the data structure itself.

data Crucible
data UltraCrucible

data Agendum a = 
    Agendum { _current :: DirectedPosition
            , _trail :: Trail
            , _trailCost :: Int
            , _cost :: Int
            } deriving (Show, Eq)
makeLenses ''Agendum   

type Agenda a = P.MinPQueue Int (Agendum a)

I created the Searchable class that handles the different types of search, depending on the crucible. Almost all the implementation of A* is common to the two types of crucible, so I have a comprehensive default implementation.

class Searchable a where

  searchCity :: Position -> CityContext (Maybe (Agendum a))
  searchCity startPos = 
    do agenda <- initAgenda startPos
       aStar agenda S.empty
...
... and so on      

The interesting part comes with the call to successors, that creates the next states (in this case, valid Moves) from a particular state. This has its type defined in the Searchable class:

successors :: (Agendum a) -> DirectedPosition -> CityContext (Q.Seq Move)

Note that it needs to have the agendum passed in, so that Haskell knows which instance of the successors function to use.

The only instance details of the Searchable typeclass are the implementations of successors, each of which calls successorWithRange with the correct range. Note that this immediately throws away the passed-in Agendum.

instance Searchable Crucible where
  successors _ = successorsWithRange (1, 3)

instance Searchable UltraCrucible where
  successors _ = successorsWithRange (4, 10)

The final step is to solve the problem, but with the correct typeclass for each part. I do that by specifying the type of the Agendum returned by searchCity.

part1, part2 :: City -> Int
part1 city = maybe 0 _cost result
    where s = city ^. start
          result = runReader (searchCity s) city :: (Maybe (Agendum Crucible))

part2 city = maybe 0 _cost result
    where s = city ^. start
          result = runReader (searchCity s) city :: (Maybe (Agendum UltraCrucible))

Code

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