An Unusual Application for Dijkstra

Today will be the final write-up for a 2021 Advent of Code problem. It will also serve as a capstone for the work on Dijkstra's algorithm I did back in the summer! This problem uses Dijkstra's algorithm, but in a more unusual way! We'll be working on Day 23 from last year. And for my part, I'll say that days 21-24 were all extremely challenging, so this is one of the "final boss" puzzles!

Like our previous write-ups, this is an In-Depth walkthrough, and it's a long one! So get ready for some details! The code is available on GitHub as always so you can follow along.

Problem Statement

For this puzzle, we start with a set of tokens divided into 4 rooms with a hallway allowing them to move around.

#############
#...........#
###B#C#B#D###
  #A#D#C#A#
  #########

Our goal is to rearrange the tokens so that the A tokens are both in the first room, the B tokens are in the second room, the C tokens are in the third room, and the D tokens are in the fourth room.

#############
#...........#
###A#B#C#D###
  #A#B#C#D#
  #########

However, there are a lot of restrictions on the possible moves. First, token's can't move past each other in the hall (or rooms). If D comes out of the fourth room first, we cannot then move the A in that room anywhere to the left. It could only go to a space on the right.

#############
#.......D...#
###B#C#B#.###
  #A#D#C#A#
  #########

Next, each token can only make two moves total. It can move into the hallway once, and then into its appropriate room. It can't take a side journey into a different room to make space for other tokens to pass.

On top of this, each token spends a certain amount of "power" (or "energy") to move per space. The different tokens spend a different amount of energy:

A = 1
B = 10
C = 100
D = 1000

So from the start position, we could spend 2000 energy to move D up to the right, and then only 9 energy to move A all the way to the left side.

#############
#.A.......D.#
###B#C#B#.###
  #A#D#C#.#
  #########

Our goal is to get the desired configuration with the least amount of energy expended.

For the "harder" version of this problem, not much changes. We just have 4 tokens per room, so more maneuvering steps are required.

#############
#...........#
###B#C#B#D###
  #D#C#B#A#
  #D#B#A#C#
  #A#D#C#A#
  #########

Solution Approach

The surprising solution approach (at least I was surprised when I realized it could work), is to treat this like a graph problem. Each "state" of the puzzle represents a node in the graph. Any given state has "edges" representing transitions to future states of the puzzle. The edges are weighted by how much energy is required in the transition.

Once we view the problem in this way, the solution is simple. We apply a "shortest path" algorithm (like Dijkstra's) using the "end" state of the puzzle as the destination. We'll get the series of moves that uses the least total energy.

For example, the first starting solution would represent one node. It would have an edge to this following puzzle state, with a weight of 2000, since a D is moving two spaces.

#############
#.........D.#
###B#C#B#.###
  #A#D#C#A#
  #########

There are some potential questions about the scale of this problem. If the potential number of nodes is too high, even Dijkstra's algorithm could take too long. And if the tokens could be placed arbitrarily anywhere in the puzzle space, our upper bound might be a factorial number like 23-P-16. This would be too large.

However, as a practical matter, the solution space is much smaller than this because of the many restrictions on how tokens can actually move. So we'll end up with a solution space that is still large but not intractable.

Solution Outline

As we start to outline our solution, we need to start by considering which Dijkstra library function we'll use. In order to allow monadic actions in our functions (such as logging), we'll use dijkstraM, which has the following type signature:

dijkstraM ::
  (Monad m, Foldable f, Num cost, Ord cost, Ord state) =>
  (state -> m (f state)) ->
  (state -> state -> m cost) ->
  (state -> m bool) ->
  state ->
  m (Maybe (cost, [state]))

To make this work, we need to pick the types we'll use for state and cost. For the cost, we can rely on a simple Int. For the state, we'll create a custom GraphState type that will represent the state of the solution at a particular point in time.

data GraphState = ...

We'll expand more on exactly what information goes into this type as we go along. But now that we've defined our type, we can define the three functions that we'll use as inputs to dijkstraM:

getNeighbors :: (MonadLogger m) => GraphState -> m [GraphState]
getCost :: (MonadLogger m) => GraphState -> GraphState -> m Int
isComplete :: (MonadLogger m) => GraphState -> m Bool

We can (and will) add at least one more argument to partially apply, but still, this lets us outline what a full invocation of the function might look like:

solution :: (MonadLogger m) => GraphState -> m (Maybe (Int, [GraphState])
solution initialState = dijkstraM getNeighbors getCost isComplete initialState

Completeness Check

So now let's start filling in these functions. We'll start with the completeness check, since that's the easiest. Because this check is run fairly often, we want to make it as quick as possible. So instead of doing a full completeness check on the state each time we call it, we'll store a specific field in the graph state called roomsFull.

data GraphState = GraphState
  { roomsFull :: Int -- Initially 0, increments when we finish a room
  ...
  }

This field will be 0 when we initialize the state, and whenever we "complete" a room in our search path, we'll bump the number up. Checking for completeness then is as simple as checking that we've completed all 4 rooms.

isComplete :: (MonadLogger m) => GraphState -> m Bool
isComplete gs = return (roomsFull gs == 4)

Cost

It would be more convenient to combine the cost with the neighbors function, like in dijkstraAssoc. But we don't have this option if we want to use a monad. Calculating the cost between two raw graph states would be a little tricky, since we'd have to go through a lot of cases to see what has actually changed.

However, it gets easier if we include the "last move" as part of the GraphState type. So let's start defining what a Move looks like. To start, we'll include a NoMove constructor for the initial position, and we'll make a note that the GraphState will include this field.

data Move =
  NoMove |
  ...

data GraphState = GraphState
  { lastMove :: Move
  , roomsFull :: Int
  ...
  }

So how do we describe a move? Because the rules are so constrained, we can be sure every move has the following:

1. A particular token that is moving.
2. A particular "hall space" that it is moving to or from.
3. A particular "room" that it is moving to or from.

Each of these concepts is easily enumerated, so let's make some Enum types that are also indexable (we'll see why soon):

data Token = A | B | C | D
  deriving (Show, Eq, Ord, Enum, Ix)

data Room = RA | RB | RC | RD
  deriving (Show, Eq, Ord, Enum, Ix)

-- Can never occupy spaces above the room like H3, H5, H7, H9
data HallSpace = H1 | H2 | H4 | H6 | H8 | H10 | H11
  deriving (Show, Eq, Ord, Enum, Ix)

Now we can describe the Move constructor with these three items, as well as two more pieces of data. First, an Int paired with the room describing the "slot" of the room involved. For example, the top "slot" of a room would be 1, the space below it would be 2, and so on. Finally, we'll include a Bool telling us if the move is leaving the room (True) or entering the room (False). This won't be necessarily for calculations, but it helps with debugging.

data Move =
  NoMove |
  Move Token HallSpace (Room, Int) Bool
  deriving (Show, Eq, Ord)

So what is the cost of a move? We have to calculate the distance, and we have to know the power multiplier. So let's make two constant arrays that we'll reference. First, let's match each token to its multiplier:

tokenPower :: A.Array Token Int
tokenPower = A.array (A, D) [(A, 1), (B, 10), (C, 100), (D, 1000)]

Now we want to match each pair of "hall space" and "room" with a distance measurement. This tells us how many moves it takes to get from the hall space to the space above the room. For example, the first hall space requires 2 moves to get to room A and 4 to get to room B, while the second space only requires 1 and 3 moves, respectively:

hallRoomDistance :: A.Array (HallSpace, Room) Int
hallRoomDistance = A.array ((H1, RA), (H11, RD))
  [ ((H1, RA), 2), ((H1, RB), 4), ((H1, RC), 6), ((H1, RD), 8)
  , ((H2, RA), 1), ((H2, RB), 3), ((H2, RC), 5), ((H2, RD), 7)
  ...
  ]

Here's what the complete array looks like:

hallRoomDistance :: A.Array (HallSpace, Room) Int
hallRoomDistance = A.array ((H1, RA), (H11, RD))
  [ ((H1, RA), 2), ((H1, RB), 4), ((H1, RC), 6), ((H1, RD), 8)
  , ((H2, RA), 1), ((H2, RB), 3), ((H2, RC), 5), ((H2, RD), 7)
  , ((H4, RA), 1), ((H4, RB), 1), ((H4, RC), 3), ((H4, RD), 5)
  , ((H6, RA), 3), ((H6, RB), 1), ((H6, RC), 1), ((H6, RD), 3)
  , ((H8, RA), 5), ((H8, RB), 3), ((H8, RC), 1), ((H8, RD), 1)
  , ((H10, RA), 7), ((H10, RB), 5), ((H10, RC), 3), ((H10, RD), 1)
  , ((H11, RA), 8), ((H11, RB), 6), ((H11, RC), 4), ((H11, RD), 2)
  ]

Now calculating the cost is fairly straightforward. We get the distance to the room, add the slot within the room, and then multiply this by the power multiplier.

getCost :: (MonadLogger m) => GraphState -> GraphState -> m Int
getCost _ gs = if lastMove gs == NoMove
  then return 0
  else do
    let (Move token hs (rm, slot) _) = lastMove gs
    let mult = tokenPower A.! token
    let distance = slot + hallRoomDistance A.! (hs, rm)
    return $ mult * distance

Finishing the Graph State

Our solution is starting to take on a bit more shape, but we need to complete our GraphState type before we can make further progress. But now armed with the notion of a Token, we can fill in the remaining fields that describe it. Each room has a list of tokens that are currently residing there. And then each hall space either has a token there or not, so we have Maybe Token fields for them.

data GraphState = GraphState
  { lastMove :: Move
  , roomsFull :: Int
  , roomA :: [Token]
  , roomB :: [Token]
  , roomC :: [Token]
  , roomD :: [Token]
  , hall1 :: Maybe Token
  , hall2 :: Maybe Token
  , hall4 :: Maybe Token
  , hall6 :: Maybe Token
  , hall8 :: Maybe Token
  , hall10 :: Maybe Token
  , hall11 :: Maybe Token
  }
  deriving (Show, Eq, Ord)

Sometimes it will be useful for us to access parts of the state in a general way. We might want a function to access "one of the rooms" or "one of the hall spaces". Some day, I might revise my solution to use proper Haskell "Lenses", which would be ideal for this problem. But for now we'll define a couple simple type aliases for a RoomLens to access the tokens in a general room, and a HallLens for looking at a general hall space.

type RoomLens = GraphState -> [Token]
type HallLens = GraphState -> Maybe Token

One last piece of boilerplate we'll want will be to have "split lists" for each room. Each of these is a tuple of two lists. The first list is the hall spaces to the "left" of that room, and the second has the hall spaces to the "right" of the room.

These lists will help us answer questions like, "how many empty hall spaces can we move to from this room moving left?", or "what is the first token to the right of this room?" For these to be useful, each hall space should also include the "lens" into the GraphState, so we can examine what token lives there.

For example, room A has H2 and H1 to its left (in that order), and then H4, H6, H8, H10 and H11 to its right. We'll match each HallSpace with its HallLens, so H1 combines with the hall1 field from GraphState, and so on.

aSplits :: ([(HallLens, HallSpace)], [(HallLens, HallSpace)])
aSplits =
  ( [(hall2, H2), (hall1, H1)]
  , [(hall4, H4), (hall6, H6), (hall8, H8), (hall10, H10), (hall11, H11)]
  )

Here's what the rest of those look like:

bSplits :: ([(HallLens, HallSpace)], [(HallLens, HallSpace)])
bSplits =
  ( [(hall4, H4), (hall2, H2), (hall1, H1)]
  , [(hall6, H6), (hall8, H8), (hall10, H10), (hall11, H11)]
  )

cSplits :: ([(HallLens, HallSpace)], [(HallLens, HallSpace)])
cSplits =
  ( [(hall6, H6), (hall4, H4), (hall2, H2), (hall1, H1)]
  , [(hall8, H8), (hall10, H10), (hall11, H11)]
  )

dSplits :: ([(HallLens, HallSpace)], [(HallLens, HallSpace)])
dSplits =
  ( [(hall8, H8), (hall6, H6), (hall4, H4), (hall2, H2), (hall1, H1)]
  , [(hall10, H10), (hall11, H11)]
  )

It would be easy enough to use a common function with splitAt to describe all of these. But once again, we'll reference these many times throughout the solution, so using constants instead of requiring function logic could help make our code faster.

Moves from a Particular Room

Now it's time for the third and largest piece of the puzzle: calculating the "next" states, or the "neighboring" states of a particular graph state. This means determining what moves are possible from a particular position. This is a complex problem that we'll have to keep breaking down into smaller and smaller parts.

We can first observe that every move involves one room and the hallway - there are no moves from room to room. So we can divide the work by considering all the moves concerning one particular room. Then there are three cases for each room:

1. The room is complete; it is full of the appropriate token.
2. The room is empty or partially full of the appropriate token.
3. The room has mismatched tokens inside.

In case 1, we'll propose no moves involving this room. In case 2, we will try to find the appropriate token in the hall and bring it into the room (from either direction). In case 3, we will consider all the ways to move a token out of the room.

We'll do all this in a general function roomMoves. This function needs to know the room size, the appropriate token for the room, the appropriate lens for accessing the room, and finally, the split list corresponding to the room. This leads to a long type signature, but each parameter has its role:

roomMoves ::
  (MonadLogger m) =>
  Int ->
  Token ->
  Room ->
  RoomLens ->
  ([(HallLens, HallSpace)], [(HallLens, HallSpace)]) ->
  GraphState ->
  m [GraphState]
roomMoves rs tok rm roomLens splits gs = ...

For getNeighbors, all we have to do is invoke this function once for each room and combine the results.

getNeighbors :: (MonadLogger m) => Int -> GraphState -> m [GraphState]
getNeighbors rs gs = do
  arm <- roomMoves rs A RA roomA aSplits gs
  brm <- roomMoves rs B RB roomB bSplits gs
  crm <- roomMoves rs C RC roomC cSplits gs
  drm <- roomMoves rs D RD roomD dSplits gs
  return $ arm <> brm <> crm <> drm

Now back to roomMoves. Let's start by defining the three cases mentioned above. The first case is easy to complete.

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = ...
  | otherwise = ...

Now let's consider the second case. We want to search each direction from this room to try to find a hall space containing the matching token. We can do this with a recursive helper function. In the base case, we're out of hall spaces to search, so we return Nothing:

findX :: Token -> GraphState -> [(HallLens, HallSpace)] -> Maybe HallSpace
findX _ _ [] = Nothing
findX tok gs ((lens, space) : rest) = ...

Then there are three simple cases for what to do with the next space. If we have an instance of the token, return the space. If we have a different token, the answer is Nothing (we are blocked). If there is no token there, we continue the search recursively.

findX :: Token -> GraphState -> [(HallLens, HallSpace)] -> Maybe HallSpace
findX _ _ [] = Nothing
findX tok gs ((lens, space) : rest)
  | lens gs == Just tok = Just space
  | isJust (lens gs) = Nothing
  | otherwise = findX tok gs rest

Using our split lists, we can find the potential spaces on the left and the right by applying our findX helper.

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = do
    let maybeLeft = findX tok gs (fst splits)
        maybeRight = findX tok gs (snd splits)
        halls = catMaybes [maybeLeft, maybeRight]
        ...
  | otherwise = ...

For right now, let's just worry about constructing the Move object. Later on, we'll fill out a function to apply this move:

applyHallMove :: Int -> Token -> RoomLens -> GraphState -> Move -> GraphState

So to finish the case, we get the "slot" number to move to by considering the length of the room currently. Then we construct the Move, and apply it against our two possible outcomes.

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = do
    let maybeLeft = findX tok gs (fst splits)
        maybeRight = findX tok gs (snd splits)
        halls = catMaybes [maybeLeft, maybeRight]
        slot = rs - length (roomLens gs)
        moves = map (\h -> Move tok h (rm, slot) False) halls
    return $ map (applyHallMove rs tok roomLens gs) moves
  | otherwise = ...

Moves Out of the Room

Now let's consider the third case - moving a token out of a room. This requires finding as many consecutive "empty" hall spaces in each direction as we can. This will be another recursive helper like findX:

findEmptyHalls :: GraphState -> [(HallLens, HallSpace)] -> [HallSpace] -> [HallSpace]
findEmptyHalls _ [] accum = accum
findEmptyHalls gs ((lens, space) : rest) accum = ...

Once we hit a Just token value in the graph state, we can return our accumulated list. But otherwise we keep recursing.

findEmptyHalls :: GraphState -> [(HallLens, HallSpace)] -> [HallSpace] -> [HallSpace]
findEmptyHalls _ [] accum = accum
findEmptyHalls gs ((lens, space) : rest) accum = if isJust (lens gs) then accum
  else findEmptyHalls gs rest (space : accum)

Now we can apply this back in our roomMoves function with both sides of the splits.

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = ...
  | otherwise = do
    let (topRoom : restRoom) = roomLens gs
        halls = findEmptyHalls gs (fst splits) [] <> findEmptyHalls gs (snd splits) []
        ...

Once again then, we calculate the "slot" value and construct the new move using each of the hall spaces. Notice that the slot calculation is different. We want to subtract the length of the "rest" of the room from the room size, since this gives the appropriate slot value.

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = ...
  | otherwise = do
    let (topRoom : restRoom) = roomLens gs
        halls = findEmptyHalls gs (fst splits) [] <> findEmptyHalls gs (snd splits) []
        slot = rs - length restRoom
        moves = map (\h -> Move topRoom h (rm, slot) True) halls
    ...

Then, as before, we'll assume we have a helper to "apply" the move, and return the new graph states. Notice this time, we set the move flag as True, since the move is coming out of the room.

applyRoomMove :: GraphState -> Token -> Move -> GraphState
applyRoomMove = ...

roomMoves rs tok rm roomLens splits gs 
  | roomLens gs == replicate rs tok = return []
  | all (== tok) (roomLens gs) = ...
| otherwise = do
    let (topRoom : restRoom) = roomLens gs
        halls = findEmptyHalls gs (fst splits) [] <> findEmptyHalls gs (snd splits) []
        slot = rs - length restRoom
        moves = map (\h -> Move topRoom h (rm, slot) True) halls
    return $ map (applyRoomMove gs tok) moves

Now let's work on these two "apply" helpers. Each will take the current state and the Move and construct the new GraphState.

Applying moves

We'll start by applying the move from the room. Of course, for the NoMove case, we return the original state.

applyRoomMove :: GraphState -> Move -> GraphState
applyRoomMove gs NoMove = gs
applyRoomMove gs m@(Move token h (rm, slot) _) = ...

Now with all our new information, we'll update the GraphState in two stages, because this will require two case statements. First, we'll update the hall space to contain the moved token. We'll also place the move m into the lastMove spot.

applyRoomMove :: GraphState -> Move -> GraphState
applyRoomMove gs NoMove = gs
applyRoomMove gs m@(Move token h (rm, slot) _) =
  let gs2 = case h of
        H1 -> gs {hall1 = Just token, lastMove = m}
        H2 -> gs {hall2 = Just token, lastMove = m}
        H4 -> gs {hall4 = Just token, lastMove = m}
        H6 -> gs {hall6 = Just token, lastMove = m}
        H8 -> gs {hall8 = Just token, lastMove = m}
        H10 -> gs {hall10 = Just token, lastMove = m}
        H11 -> gs {hall11 = Just token, lastMove = m}
  in  ...

Now we need to modify the room to drop the top token. Unfortunately, we can't actually use a RoomLens argument in conjunction with record syntax updating, so this needs to be a case statement as well. With proper lenses, we could probably simplify this.

applyRoomMove :: GraphState -> Token -> Move -> GraphState
applyRoomMove gs roomToken NoMove = gs
applyRoomMove gs roomToken m@(Move token h (rm, slot) _) =
  let gs2 = case h of
        H1 -> gs {hall1 = Just token, lastMove = m}
        H2 -> gs {hall2 = Just token, lastMove = m}
        H4 -> gs {hall4 = Just token, lastMove = m}
        H6 -> gs {hall6 = Just token, lastMove = m}
        H8 -> gs {hall8 = Just token, lastMove = m}
        H10 -> gs {hall10 = Just token, lastMove = m}
        H11 -> gs {hall11 = Just token, lastMove = m}
  in  case rm of
    RA -> gs2 { roomA = tail (roomA gs)}
    RB -> gs2 { roomB = tail (roomB gs)}
    RC -> gs2 { roomC = tail (roomC gs)}
    RD -> gs2 { roomD = tail (roomD gs)}

That's all for applying a move from the room. Applying a move from the hall into the room is similar. But we have the extra task of determining if the destination room is now complete. So in this case we actually can make use of the RoomLens.

applyHallMove :: Int -> RoomLens -> GraphState -> Move -> GraphState
applyHallMove rs roomLens gs NoMove = gs
applyHallMove rs roomLens gs m@(Move token h (rm, slot) _) = ...

As before, we start by updating the hall space (now it's Nothing) and the lastMove field. We'll also update the finishedCount on this update step.

applyHallMove :: Int -> RoomLens -> GraphState -> Move -> GraphState
applyHallMove rs roomLens gs NoMove = gs
applyHallMove rs roomLens gs m@(Move token h (rm, slot) _) =
  let gs2 = case h of
        H1 -> gs {hall1 = Nothing, lastMove = m, roomsFull = finishedCount}
        H2 -> gs {hall2 = Nothing, lastMove = m, roomsFull = finishedCount}
        H4 -> gs {hall4 = Nothing, lastMove = m, roomsFull = finishedCount}
        H6 -> gs {hall6 = Nothing, lastMove = m, roomsFull = finishedCount}
        H8 -> gs {hall8 = Nothing, lastMove = m, roomsFull = finishedCount}
        H10 -> gs {hall10 = Nothing, lastMove = m, roomsFull = finishedCount}
        H11 -> gs {hall11 = Nothing, lastMove = m, roomsFull = finishedCount}
  in  ...
  where
    finishedCount = ...

How do we implement the finishedCount? It's not too difficult. We can easily assess if it's finished by checking the roomLens on the original state and seeing if it's equal to "Room Size minus 1". Then the finished count increments if this is true.

applyHallMove :: Int -> RoomLens -> GraphState -> Move -> GraphState
applyHallMove rs roomLens gs NoMove = gs
applyHallMove rs roomLens gs m@(Move token h (rm, slot) _) =
  let gs2 = case h of
        H1 -> gs {hall1 = Nothing, lastMove = m, roomsFull = finishedCount}
        H2 -> gs {hall2 = Nothing, lastMove = m, roomsFull = finishedCount}
        H4 -> gs {hall4 = Nothing, lastMove = m, roomsFull = finishedCount}
        H6 -> gs {hall6 = Nothing, lastMove = m, roomsFull = finishedCount}
        H8 -> gs {hall8 = Nothing, lastMove = m, roomsFull = finishedCount}
        H10 -> gs {hall10 = Nothing, lastMove = m, roomsFull = finishedCount}
        H11 -> gs {hall11 = Nothing, lastMove = m, roomsFull = finishedCount}
  in  ...
  where
    finished = length (roomLens gs) == rs - 1
    finishedCount = if finished then roomsFull gs + 1 else roomsFull gs

Now we do the same concluding step as the room move, except this time we're adding the token to the room instead of removing it.

applyHallMove :: Int -> RoomLens -> GraphState -> Move -> GraphState
applyHallMove rs roomLens gs NoMove = gs
applyHallMove rs roomLens gs m@(Move token h (rm, slot) _) =
  let gs2 = case h of
        H1 -> gs {hall1 = Nothing, lastMove = m, roomsFull = finishedCount}
        H2 -> gs {hall2 = Nothing, lastMove = m, roomsFull = finishedCount}
        H4 -> gs {hall4 = Nothing, lastMove = m, roomsFull = finishedCount}
        H6 -> gs {hall6 = Nothing, lastMove = m, roomsFull = finishedCount}
        H8 -> gs {hall8 = Nothing, lastMove = m, roomsFull = finishedCount}
        H10 -> gs {hall10 = Nothing, lastMove = m, roomsFull = finishedCount}
        H11 -> gs {hall11 = Nothing, lastMove = m, roomsFull = finishedCount}
  in case rm of
    RA -> gs2 {roomA = A : roomA gs}
    RB -> gs2 {roomB = B : roomB gs}
    RC -> gs2 {roomC = C : roomC gs}
    RD -> gs2 {roomD = D : roomD gs}
  where
    finished = length (roomLens gs) == rs - 1
    finishedCount = if finished then roomsFull gs + 1 else roomsFull gs

Making the Initial State

That's the conclusion of the algorithm functions; now we just need some glue, such as the initial states and pulling it all together. For the first time with our Advent of Code problems, we don't actually need to parse an input file. We could go through this process, but the "hard" input is still basically the same size, so we can just define these initial states in code.

Let's recall that our basic case looks like this:

#############
#...........#
###B#C#B#D###
  #A#D#C#A#
  #########

We'll translate it into an initial state as:

initialState1 :: GraphState
initialState1 = GraphState
  NoMove 0 [B, A] [C, D] [B, C] [D, A]
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing

Our slightly harder version has the same structure, just with letters in more unusual places.

{-
#############
#...........#
###C#A#D#D###
  #B#A#B#C#
  #########
-}

initialState2 :: GraphState
initialState2 = GraphState
  NoMove 0 [C, B] [A, A] [D, B] [D, C]
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing

Now for the "hard" part of the problem, we increase the room size to 4, and insert additional characters into each room. This is what those states look like.

initialState3 :: GraphState
initialState3 = GraphState
  NoMove 0 [B, D, D, A] [C, C, B, D] [B, B, A, C] [D, A, C, A]
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing

initialState4 :: GraphState
initialState4 = GraphState
  NoMove 0 [C, D, D, B] [A, C, B, A] [D, B, A, B] [D, A, C, C]
  Nothing Nothing Nothing Nothing Nothing Nothing Nothing

Solving the Problem

Now we can "solve" each of the problems. Our solution code is essentially the same for each side. The "hard" part just passes 4 as the room size.

solveDay23Easy :: GraphState -> IO (Maybe Int)
solveDay23Easy gs = runStdoutLoggingT $ do
   result <- dijkstraM (getNeighbors 2) getCost isComplete gs
   case result of
    Nothing -> return Nothing
    Just (d, path) -> return $ Just d

solveDay23Hard :: GraphState -> IO (Maybe Int)
solveDay23Hard gs = runStdoutLoggingT $ do
   result <- dijkstraM (getNeighbors 4) getCost isComplete gs
   case result of
    Nothing -> return Nothing
    Just (d, path) -> return $ Just d

And now our code is complete! We can run it and the total distance. It actually turns out to require less energy for the second case in each group:

First  Size-2: 12521
Second Size-2: 10526
First  Size-4: 44169
Second Size-4: 41284

It's also possible, if we want, to print out the "path" we took by considering the moves in each state!

solveDay23Easy :: GraphState -> IO (Maybe Int)
solveDay23Easy gs = runStdoutLoggingT $ do
   result <- dijkstraM (getNeighbors 2) getCost isComplete gs
   case result of
    Nothing -> return Nothing
    Just (d, path) -> do
      forM_ path $ \gs' -> logDebugN (pack . show $ lastMove gs')
      return $ Just d

Here's the path we take for this simple version! Remember that True moves come from the room into the hall, and False moves go from the hall back into the room.

[Debug] Move D H10 (RD,1) True
[Debug] Move A H2 (RD,2) True
[Debug] Move B H4 (RC,1) True
[Debug] Move C H6 (RB,1) True
[Debug] Move C H6 (RC,1) False
[Debug] Move D H8 (RB,2) True
[Debug] Move D H8 (RD,2) False
[Debug] Move D H10 (RD,1) False
[Debug] Move B H4 (RB,2) False
[Debug] Move B H4 (RA,1) True
[Debug] Move B H4 (RB,1) False
[Debug] Move A H2 (RA,1) False

As a final note, the scale of the search is fairly large but by no means intractable. My solution doesn't give an instant answer, but it returns within a minute or so.

Conclusion

That is all for our review of Advent of Code 2021! We'll have the video walkthrough later in the week. And then in a couple weeks, we'll be ready to start Advent of Code 2022, so stay tuned for that!

If you've enjoyed these tutorials, make sure to subscribe to our mailing list! We've got a big offer coming up next week that you won't want to miss!