This was the challenge where I over-reached myself. Day 24 was about implementing a cellular automaton, much like Conway's Game of Life. It seems that all the cool kids are using the Store comonad for doing this kind of puzzle, so I thought I'd do the same.
Part 1: Strange new ideas, but they work
I found Chris Penner's blog post on implementing the Game of Life to be very clear, and I based my implementation on his. That post shows using Representable to memoise the state of the grid as time goes by, to prevent they entire history of the automaton having to be recalculated from scratch for each new generation.
I won't go into the details of how the Store comonad works and how it's used for cellular automata: you can read Penner's post for that or Edward Kmett's series on doing much the same thing. But the basic idea is that the end result of running the automaton is a Store, which presents itself as a function that takes a location and returns the state of the cell at that place. Representable comes in as being the data type of all possible locations. The Store holds the data, the Representable tells you where to look.
But using Representable introduces its own problems. The set of all possible values of a Representable has to be the same as the set of all possible locations in the Store. That's a constraint that has to be enforced at the type level. That means that the space can be either infinite (and using something like a Stream) or finite, and using dependent types to limit what values the Representable can hold.
Penner uses Vectors of fixed size. The part 1 problem also operates on a fixed-size grid. I went with that approach, but using a Matrix rather than a Vector of Vectors, in an attempt to understand the approach.
I'm not sure I succeeded in understanding it, but it worked, and produced the correct result. You can see the code online, and there's not much to say about it that isn't expressed better in Penner's blog post.
Part 2: Overreach and scaling back
Part 2 of the problem was a whole different idea, and it really stumped me when using the comonad approach. Part 2 moves to working on an infinite grid, but one that's not symmetrical in that not every cell has the same arrangement of neighbours. It turned out very quickly that I didn't understand enough about the Store + Representable idea to extend it to something that would work in this new situation.
My first thought was to use a Map of cells for the the underlying grid, rather than a Matrix. The Map would have an entry for each cell position that was known; unknown cells would have some default value. I tried re-implementing the Part 1 solution this way and got stuck.
I eventually asked about how to solve this in the Haskell subreddit, and got some good and very useful answers. Unfortunately, it turned out that a Map wouldn't work to represent the grid, as Map is strict in its key and so would require the whole grid to be known from the start.
I also got concerned about how to handle the asymmetry of the grid, which requires knowing the absolute position of the current cell. Again, that didn't seem to be the most straightforward detail to handle.
So I decided to abandon the co0l-but-complex approach and went back to basics with an obvious and explicit approach.
I decided to represent the bugs on the grid as a Set of Cells, with each member of the Set being a bug.
data Cell = Cell { level :: Int
, row :: Int
, column :: Int
} deriving (Show, Eq, Ord)
type Grid = S.Set Cell
I also wrote a function that determines all the neighbouring cells of a particular cell, using the fact that Set is a Monoid to neatly combine the neighbours in the four directions.
neighbourSpaces :: Cell -> Grid
neighbourSpaces cell =
( (neighbourSpacesLeft cell)
<> (neighbourSpacesRight cell)
<> (neighbourSpacesAbove cell)
<> (neighbourSpacesBelow cell)
)
The functions for generating the neighbours in each direction are the same, so I'll just show one of them.
neighbourSpacesLeft :: Cell -> Grid
neighbourSpacesLeft (Cell {..})
| column == 4 && row == 3 = S.fromList [ Cell { level = (level + 1),
row = r, column = 5}
| r <- [1..gridSize] ]
| column == 1 = S.singleton ( Cell { level = (level - 1),
row = 3, column = 2})
| otherwise = S.singleton ( Cell { column = (column - 1), ..})
This treats the three cases for finding cells "to the left of" this one: if this cell is in the middle of the fourth column, there are five neighbouring cells in the next level; if this cell is in the first column, there's one neighbour in the previous level; otherwise, there's one neighbour in the same level. (Note the use of "record wildcards", a GHC extension I spotted in some code of my friend Attila Sztupak.)
There's a little function that counts how many neighbours of a position are occupied:
countOccupiedNeighbours :: Cell -> Grid -> Int
countOccupiedNeighbours cell grid = S.size $ S.intersection grid $ neighbourSpaces cell
The rules are implemented directly as two predicates, one for saying if an existing bug survives and one for saying if a new bug is born.
bugSurvives :: Grid -> Cell -> Bool
bugSurvives grid cell = alive && oneNeighbour
where alive = cell `S.member` grid
oneNeighbour = (countOccupiedNeighbours cell grid) == 1
bugBorn :: Grid -> Cell -> Bool
bugBorn grid cell = dead && (nNbrs == 1 || nNbrs == 2)
where dead = cell `S.notMember` grid
nNbrs = countOccupiedNeighbours cell grid
Updating to the next generation uses these two rules and combines the results. First, I find all the occupied spaces and filter them to discover which bugs survive. Then, I find all the empty cells that neighbour one of the bugs, and filter the empty cells to discover which ones give birth to new bugs. The empties come from taking each bug, finding its neighbours, and combining those sets into the overall set of empties (after removing all positions that already have a bug in them).
update :: Grid -> Grid
update grid = S.union (S.filter (bugSurvives grid) bugs) (S.filter (bugBorn grid) empties)
where bugs = grid
empties = (S.foldr mergeEmpties S.empty grid) `S.difference` bugs
mergeEmpties cell acc = S.union acc $ neighbourSpaces cell
The final result comes from iterate-ing the update rules, dropping the first few generations we're not interested in, and counting the bugs in the next one.
main :: IO ()
main =
do grid0 <- readGrid
let finalGrid = head $ drop 200 $ iterate update grid0
print $ S.size finalGrid
After all that fuss around comonads, this seems like a much more direct and obvious solution to the problem.
Code
You can find the code locally or on Github.