# Advent of Code 2022 day 23

Day 23 was the first cellular automaton type puzzle of the year. Every time these come up, I consider implementing it as a Representable-powered Comonad of elements, and every year I decide that I've neither the time nor the brain capacity to build one. But one year I will!

## Representation

My first decision was how to represent things and keep track of the simulation state. Some decisions were simple: the grove was represented sparsely, as a Set of Elfs. Each Elf knew its position and where it was moving to. The Grove overall knew about the elves, and also kept track of the current Directions for elf movement (an infinite, cycling list) and the simulation generation number.

type Position = V2 Int -- r, c

data Direction = North | South | West | East
deriving (Show, Eq, Ord, Enum, Bounded)

data Elf = Elf { _current :: Position, _proposed :: Position}
deriving (Eq, Ord)
makeLenses ''Elf

instance Show Elf where
show elf = "Elf {c= " ++ (show (elf ^. current))
++ ", p= " ++ (show (elf ^. proposed))
++ " -> " ++ (show (directionOfElf elf))
++ "}"

data Grove = Grove { currentGrove :: S.Set Elf, proposalDirections :: [Direction], elapsedRounds :: Int}
deriving (Eq)

(I used a custom Show for the Elf, so I could see the direction the elf was proposing to move in. It made checking my code much easier., and used the helper directionOfElf)

directionOfElf :: Elf -> Maybe Direction
directionOfElf elf
| delta == V2 0 1 = Just North
| delta == V2 0 -1 = Just South
| delta == V2 1 0 = Just East
| delta == V2 -1 0 = Just West
| otherwise = Nothing
where delta = (elf ^. proposed) ^-^ (elf ^. current) 

I was in two minds as to whether to use a State monad, or just pass around a set of Elves. In the end, I went with the State monad.

type GroveState = State Grove

## Simulation

That meant the simulation was clean and looked rather imperative. There are two functions for running the simulation: simulateToCompletion runs the simulation until no elf moves; simulateN simulates n rounds.

simulateToCompletion :: GroveState ()
simulateToCompletion =
do oldGrove <- gets currentGrove
simulateOnce
newGrove <- gets currentGrove
if oldGrove == newGrove
then return ()
else simulateToCompletion

simulateN :: Int -> GroveState ()
simulateN 0 = return ()
simulateN n =
do simulateOnce
simulateN (n - 1)

Note that none of the simulations return a value. I extract what I want from the final state, and run the simulation with execState

part1, part2 :: Grove -> Int
part1 grove = countEmpty grove' bounds
where grove' = currentGrove $execState (simulateN 10) grove bounds = findBounds grove' part2 grove = elapsedRounds grove' where grove' = execState simulateToCompletion grove I split each simulation round into five stages: 1. Each Elf proposes where it wants to move 2. Elves moving to the same space withdraw their proposed moves 3. All the elves move to their proposed spaces 4. Update the movement-direction priority list 5. Update the number of simulation rounds simulateOnce = do proposeMoves removeClashes moveElves updateDirections updateCount I'll describe the three interesting stages in turn. ### Propose moves The top-level is simple: get the grove (a.k.a. set of elves), get the direction priority list, then ask each elf in the grove to propose where they want to move to. proposeMoves = do grove <- gets currentGrove proposalsInf <- gets proposalDirections let proposals = take 4 proposalsInf let grove' = S.map (makeProposal grove proposals) grove modify' (\g -> g { currentGrove = grove'}) makeProposal asks a specific Elf to propose where it will move next. If it's isolated, it stays still. Otherwise, it checks if it can move in any of the four directions, then there's a horrendous bit of plumbing to find the first viable move. makeProposal :: S.Set Elf -> [Direction] -> Elf -> Elf makeProposal grove directions elf | isolated grove elf = elf | otherwise = fromMaybe elf$ getFirst $mconcat$ fmap First $fmap (proposedStep grove elf) directions proposedStep :: S.Set Elf -> Elf -> Direction -> Maybe Elf proposedStep grove elf direction | noElves grove interfering = Just$ elf & proposed .~ (here ^+^ (stepDelta direction))
| otherwise = Nothing
where here = elf ^. current
where targets = MS.map _proposed $MS.fromSet grove ifMany t n s | n == 1 = s | otherwise = MS.insert t s Then I ask the elves no to clash. That's as a map over the elves, where each one is asked to notClash. notClash checks if the elf's proposed move is in the set of clashes. If it is, the proposed is reset to current (meaning the elf doesn't move this round). If it's not a clash, the elf remains the same. stopClashingElves :: S.Set Position -> GroveState () stopClashingElves clashes = do grove <- gets currentGrove let grove' = S.map (notClash clashes) grove modify' (\g -> g { currentGrove = grove'}) notClash :: S.Set Position -> Elf -> Elf notClash clashes elf | (elf ^. proposed) S.member clashes = elf & proposed .~ (elf ^. current) | otherwise = elf ### Move elves Finally, asking the elves to move is simple. I just update each elf's current position to be the same as its proposed position. moveElves = do grove <- gets currentGrove let grove' = S.map moveElf grove modify' (\g -> g { currentGrove = grove'}) moveElf :: Elf -> Elf moveElf elf = elf & current .~ (elf ^. proposed) ### Utility functions There are quite a few utility functions to support all this. First are a few direction-processing functions. anyNeighbour returns a set of the eight neighbouring positions of the origin. directionNeighbour does the same, but only the three positions in a certain direction. stepDelta is the position change in a particular direction. anyNeighbour :: S.Set Position anyNeighbour = S.fromList [ V2 dx dy | dx <- [-1, 0, 1] , dy <- [-1, 0, 1] , not ((dx == 0) && (dy == 0)) ] directionNeighbour :: Direction -> S.Set Position directionNeighbour North = S.filter (\d -> d ^. _y == 1) anyNeighbour directionNeighbour South = S.filter (\d -> d ^. _y == -1) anyNeighbour directionNeighbour West = S.filter (\d -> d ^. _x == -1) anyNeighbour directionNeighbour East = S.filter (\d -> d ^. _x == 1) anyNeighbour stepDelta ::Direction -> Position stepDelta North = V2 0 1 stepDelta South = V2 0 -1 stepDelta West = V2 -1 0 stepDelta East = V2 1 0 Those three functions all generate relative positions. translateTo converts them to absolute positions, given a start point. translateTo :: Position -> S.Set Position -> S.Set Position translateTo here deltas = S.map (here ^+^) deltas notElves is a predicate that returns True if there are no elves at any of the specified positions. noElves :: S.Set Elf -> S.Set Position -> Bool noElves elves tests = S.null$ S.intersection tests $S.map _current elves ## Profiling and optimisation This all worked without too much trouble. Unfortunately, it took a very long time to execute, around 18 minutes on my machine to complete the 1000-odd rounds. This prompted me to pull out the profiler for the first time this Advent of Code. It revealed that about 95% of the runtime was spent in noElves, which meant it was spending all the time performing the set intersection between the few positions and the many elves. The fix was simple enough. In makeProposal, I cache the elves near the current elf, and use that small neighbourhood to check for the presence of elves. makeProposal :: S.Set Elf -> [Direction] -> Elf -> Elf makeProposal grove directions elf | isolated localElves elf = elf | otherwise = fromMaybe elf$ getFirst $mconcat$ fmap First $fmap (proposedStep localElves elf) directions where localElves = nearby grove elf nearby :: S.Set Elf -> Elf -> S.Set Elf nearby elves elf = S.filter (\e -> (e ^. current) S.member nbrs) elves where nbrs = translateTo (elf ^. current)$ anyNeighbou

That small change was enough to reduce the runtime by two thirds. A six minute runtime is pretty bad, but there weren't any other quick fixes I could see.

I also tried defining custom Eq and Ord implementations for Elf, so that only the current position was checked. That had just about no effect.

## Code

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