The game of life with a truly infinite board

The game of life is often implemented by representing the board as a 2D boolean array. This doesn't scale very well to larger boards -- it starts to consume lots of memory, and without some separate mechanism to keep track of a list of live cells, you have to visit each board cell on each iteration. This implementation just keeps a list of live cells to represent the board state; the board "size" is limited only by the maximum of an integer.

import Data.List as L
import Data.Map  as M

type Coo = (Int,Int)
type Board = Map Coo Int

moveBoard::Coo->Board->Board
moveBoard (dx,dy) = M.mapKeysMonotonic (\(x,y)->(x + dx, y + dy))

countNeighbors::Board->Board
countNeighbors b =
  unionsWith (+) [ moved (-1, -1),  moved (0, -1),  moved (1, -1),
                   moved (-1,  0),                  moved (1,  0),
                   moved (-1,  1),  moved (0,  1),  moved (1,  1) ]
    where moved (dx, dy) = moveBoard (dx, dy) b

lifeIteration::Board->Board
lifeIteration b = M.union birth survive
  where neighbors = countNeighbors b
        birth     = M.map (const 1)  (M.filter (==3) neighbors)
        survive   = M.intersection b (M.filter (==2) neighbors)

glider = M.fromList $ L.map (\(x,y)->((x,y),1::Int)) ([(1,1),(1,2),(1,3),(2,3),(3,2)]::[(Int,Int)])

Edit: This answer was given when the reviewed code looked quite differently.

Any specific questions? Here's what stands out for me:

-
Why do toList in emptyNeighbors, then go back to Set again? You could simply use Data.Set.map there.

-
countNeighbor is very inefficient: the filter operation always iterates over all life cells, and you are calling it three times per existing cell! That's unneeded, as you only ever care about a handful of neighbourhood cells.

My idea to fix issue 2 would be to build a Map of the neighbour count of every cell. If you represent the board as a Map with only 1 cells in it, that can be done pretty efficiently using mapKeysMonotonic and unionsWith:

type Coo = (Int, Int)
type Board = Map Coo Int

moveBoard :: Coo -> Board -> Board
moveBoard (dx,dy) = M.mapKeysMonotonic (\(x, y) -> (x+dx, y+dy))

countNeighbours :: Board -> Board
countNeighbours b =
  unionsWith (+) [ moved (-1) (-1), moved 0 (-1), moved 1 (-1)
                 , moved (-1)   0 ,               moved 1  0
                 , moved (-1)   1 , moved 0   1 , moved 1  1   ]
 where moved dx dy = moveBoard (dx,dy) b

Note that usage of mapKeysMonotonic is only safe because the order of coordinates doesn't change when we add a constant. Effectively, this means that the library can simply replace the concrete coordinates without any internal resorting.

The iteration is then a simple matter of using filter, map and intersection over the result:

lifeIteration :: Board -> Board
lifeIteration b = M.union birth survive
 where neighbours = countNeighbours b
       birth      = M.map (const 1)  (M.filter (==3) neighbours)
       survive    = M.intersection b (M.filter (==2) neighbours)

Changing your formulation slightly by having a life cell with 3 neighbours "rebirth" instead of survive, as that's a bit simpler to write.

Also note that this is a bit "clever" by taking advantage of the fact that intersection always returns the value of the first Map, therefore I don't need to do another M.map (const 1) step in there.

I hope this is helpful to you.

StackExchange Code Review Q#10139, answer score: 4