Advent of Code 2024 day 15
Day 15 part 1 was fairly straightforward, but part 2 was full of detail and checking that all cases were covered.
Data structures
I stored the whole world in a single record. Positions were my typical V2, walls and boxes were Set of Position, and the robot was a Position. I used patterns for convenience.
type Position = V2 Int -- r, c
type Items = S.Set Position
data World = World { walls :: Items, boxes :: Items, robot :: Position }
deriving (Show, Eq, Ord)
pattern U, D, L, R :: Position
pattern U = V2 (-1) 0
pattern D = V2 1 0
pattern L = V2 0 (-1)
pattern R = V2 0 1Reading the data wasn't efficient (three passes over the data), but it was good enough.
mkWorld :: String -> World
mkWorld text = World { walls = walls, boxes = boxes, robot = robot }
where rows = takeWhile (not . null) $ lines text
rMax = length rows - 1
cMax = (length $ head rows) - 1
walls = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '#' ]
boxes = S.fromList [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == 'O' ]
robot = head [ V2 r c | r <- [0..rMax], c <- [0..cMax], rows !! r !! c == '@' ]
mkCommands :: String -> [Position]
mkCommands text = fmap readDirection $ concat rows
where rows = tail $ dropWhile (not . null) $ lines text
readDirection '^' = U
readDirection 'v' = D
readDirection '<' = L
readDirection '>' = RI also wrote a showWorld function for debugging, to generate the same maps as in the problem description.
showWorld :: World -> String
showWorld World { .. } = unlines rows
where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls
cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls
rows = [ [ if | V2 r c `elem` walls -> '#'
| V2 r c `elem` boxes -> 'O'
| V2 r c == robot -> '@'
| otherwise -> '.'
| c <- [0..cMax] ]
| r <- [0..rMax] ]Part 1
The main simulation was simple enough: update the position of the robot, make sure it can't go into a wall. The complication came from the boxes. The robot can move into a box if that box can be moved. That means this box and move the next box, of that box can also move. This chain of moving boxes can be any length.
I decided to wrap the box-moving in a Maybe. If a box could be moved, the moveBoxes function would return Just the world after moving the box, or Nothing if the box couldn't move. A box would test if the next space was free or contained a box that could be moved. That meant a recursive call of moveBoxes, and testing its result before moving this box.
Chaining interpretation of Maybe is handled by the type's Monad instantiation, so I used the do notation to keep the syntax neat.
In doCommand, there are three cases. First, if the robot moves into a wall, do nothing. Third, if the robot moves into free space, just update the world with the new position of the robot. But the second case, where the robot tries to move into a box, is handled by moveBoxes. If that returns Nothing, the fromMaybe ensures the world stays the same.
doCommand :: World -> Position -> World
doCommand world dir
| there `S.member` world.walls = world
| there `S.member` world.boxes = fromMaybe world world'
| otherwise = world { robot = there }
where there = world.robot ^+^ dir
world' = do boxed <- moveBoxes world dir there
return boxed { robot = there } moveBoxes has the same three cases: do Nothing if the box would move into a wall; return the world with shifted boxes if the box would move into a free space; or, if the box would move into another box, try to move that other box.
moveBoxes :: World -> Position -> Position -> Maybe World
moveBoxes world dir box
| there `S.member` world.walls = Nothing
| there `S.member` world.boxes = world'
| otherwise = Just $ world { boxes = shift world.boxes }
where there = box ^+^ dir
world' = do boxedWorld <- moveBoxes world dir there
let boxes' = shift boxedWorld.boxes
return boxedWorld { boxes = boxes'}
shift bs = S.insert there $ S.delete box bs(If you don't really understand the code, don't worry: I barely understood it while writing it. But once it type checked, it gave the right answers. So yay type checkers?)
Calculating the GPS is simple: walk over the grid, adding up the score of each box found.
gps :: World -> Int
gps World { .. } = sum score
where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls
cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls
score = [ 100 * r + c
| c <- [0..cMax]
, r <- [0..rMax]
, V2 r c `elem` boxes
]Part 2
This was more fiddly. I decided on a representation of the larger world where I only stored the left-most location of the big box in world.boxes; I'd use code to handle the "phantom" right-most location.
That gave some utility functions for creating the larger world and displaying it.
enlarge :: World -> World
enlarge World { .. } = World { walls = walls', boxes = boxes', robot = robot' }
where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls
cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls
walls' = S.unions $ S.map (\(V2 r c) -> S.fromList [V2 r (2 * c), V2 r (2 * c + 1)]) walls
boxes' = S.map (\(V2 r c) -> V2 r (2 * c)) boxes
V2 rr rc = robot
robot' = V2 rr (2 * rc)
showBigWorld :: World -> String
showBigWorld World { .. } = unlines rows
where rMax = S.findMax $ S.map (\(V2 r _) -> r) walls
cMax = S.findMax $ S.map (\(V2 _ c) -> c) walls
rows = [ [ if | V2 r c `elem` walls -> '#'
| V2 r c `elem` boxes -> '['
| (V2 r c ^+^ L) `elem` boxes -> ']'
| V2 r c == robot -> '@'
| otherwise -> '.'
| c <- [0..cMax] ]
| r <- [0..rMax] ] I also had a couple of utility functions for handling box locations. Was a location in a box? And, assuming the location is in a box, what's the box's canonical position?
isBigBox :: Position -> Items -> Bool
isBigBox here bs = S.member here bs || S.member (here ^+^ L) bs
bigBoxActual :: Items -> Position -> Position
bigBoxActual bs here
| here `S.member` bs = here
| otherwise = here ^+^ LThe logic for moving followed the same pattern as before. The robot can move if it can move all the boxes it would move into. However, one robot move could move several boxes. That meant the equivalent to moveBoxes couldn't return the new world; instead it had to return the set of moves, so that those sets could be joined to update the world.
The logic of doCommand and moveBoxes is much the same as before, but with some added fiddling to handle all the edge cases.
doBigCommand :: World -> Position -> World
doBigCommand world dir
| there `S.member` world.walls = world
| there `isBigBox` world.boxes = fromMaybe world rWorld
| otherwise = world { robot = there }
where there = world.robot ^+^ dir
movedBox = bigBoxActual world.boxes there
rWorld =
do boxMoves <- moveBigBoxes world dir movedBox
let froms = S.fromList $ fmap fst boxMoves
let tos = S.fromList $ fmap snd boxMoves
let boxes' = S.union tos (world.boxes `S.difference` froms)
return world { boxes = boxes', robot = there }
moveBigBoxes :: World -> Position -> Position -> Maybe [Move]
moveBigBoxes world dir box
| any (\t -> t `S.member` world.walls) there = Nothing
| any (\t -> t `isBigBox` world.boxes) there = allMoves
| otherwise = Just [ thisMove ]
where there = case dir of
U -> [box ^+^ U, box ^+^ R ^+^ U]
D -> [box ^+^ D, box ^+^ R ^+^ D]
L -> [box ^+^ L]
R -> [box ^+^ R ^+^ R]
_ -> []
thisMove = (box, box ^+^ dir)
allMoves = do let there' = nub $ fmap (bigBoxActual world.boxes)
$ filter (\t -> t `isBigBox` world.boxes) there
moves <- traverse (moveBigBoxes world dir) there'
let moves' = concat moves
return $ thisMove : moves'There was quite a bit of fiddling there to get everything working. Note the use of traverse to convert a [Maybe move] into a Maybe [move]. I actually used Traversable for a real reason!
A fun little puzzle, closer to real software engineering than the pure computer-science of many of them.
Code
You can get the code from my locally-hosted Git repo, or from Codeberg.