3
\$\begingroup\$

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)])
\$\endgroup\$
  • \$\begingroup\$ If you want to compute long and large sequences of Life, you might be interested in hashlife. \$\endgroup\$ – Petr Pudlák Sep 19 '13 at 18:10
3
\$\begingroup\$

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

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

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

  2. 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.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.