Game of Life implementation in Haskell

Question

I've written a small Game of Life module in Haskell, as well as a small testing application. I'm relatively new to the language, so any kind of comment about the code is welcome. The most important comments for me are comments about efficiency of the code, and of course bugs. I would also be happy to accept comments about:

• Coding Style
• "Reinventing the wheel"
• Misuse of features
• Show instance efficiency

module GameOfLife
 ( State(..)
 , Board
 , evolve
 , initBoard
 , setStates
 , nextGen ) where
import Data.List
import Data.Maybe
import qualified Data.Map as Map
data State = Alive | Dead deriving (Eq, Show)
type Coord = (Int,Int)
data Cell = Cell { cellState :: State
 , cellCoord :: Coord } deriving Show
data Board = Board { boardGrid :: (Map.Map Coord Cell)
 , boardWidth :: Int
 , boardHeight :: Int}
initBoard :: Int -> Int -> Board
initBoard width height =
 let grid = Map.fromList $ [(c, Cell Dead c) | x <- [0..width - 1], y <- [0..height - 1], let c = (x,y)]
 in Board grid width height
setState :: Board -> State -> Coord -> Board
setState (Board grid width height) state (x,y)
 | y >= height || y < 0 = error "Height is off bounds"
 | x >= width || x < 0 = error "Width is off bounds"
 | otherwise =
 let c = (x,y)
 newGrid = Map.insert c (Cell state c) grid
 in Board newGrid width height
setStates :: Board -> State -> [Coord] -> Board
setStates board state = foldl (\board coord -> setState board state coord) board
neighbours :: Board -> Coord -> [Cell]
neighbours (Board grid width height) c@(x,y)
 | not (inBounds c) = error "Coordinate off bounds"
 | otherwise =
 let neighboursCoords = filter (/= c) $ filter inBounds [(x',y') | x' <- [x - 1..x + 1], y' <- [y - 1..y + 1]]
 in map getCell neighboursCoords
 where
 inBounds (x,y) = x >= 0 && y >= 0 && x < width && y < height
 getCell (x,y) = fromJust $ Map.lookup (x,y) grid
nextGen :: Board -> Board
nextGen board =
 let
 livingNeighbours c = length $ filter (==Alive) $ map cellState (neighbours board c)
 takeState state = map cellCoord $ filter (\c -> cellState c == state) $ Map.elems $ boardGrid board
 underPop = filter (\coords -> (livingNeighbours coords) < 2) $ takeState Alive
 overPop = filter (\coords -> (livingNeighbours coords) > 3) $ takeState Alive
 newBorn = filter (\coords -> (livingNeighbours coords) == 3) $ takeState Dead
 revive b = setStates b Alive newBorn
 kill b = setStates b Dead (overPop ++ underPop)
 in kill $ revive board
evolve :: Board -> [Board]
evolve board =
 let next = nextGen board
 in next:evolve next
-- Show instances --
instance Show Board where
 show (Board grid width height) =
 intercalate "\n" $ map gridLine [0..height - 1]
 where gridLine l =
 concat $ map (charState . cellState . fromJust) [Map.lookup (x,l) grid | x <- [0..width -1]]
 charState state
 | state == Dead = " "
 | state == Alive = "@"

EDIT: New version with Array:

module GameOfLife
 ( State(..)
 , Board
 , evolve
 , initBoard
 , setStates
 , nextGen
 , toText
 ) where
import Data.List
import Data.Array
import System.IO
import qualified Data.Text as T
data State = Alive | Dead deriving (Eq, Show)
type Coord = (Int,Int)
type Board = Array Coord State
initBoard :: Coord -> Board
initBoard (width,height) =
 let bounds = ((0,0),(width - 1,height - 1))
 in array bounds $ zip (range bounds) (repeat Dead)
setStates :: Board -> [(Coord,State)] -> Board
setStates = (//)
getStates :: Board -> [Coord] -> [State]
getStates board coords = map (board!) coords
neighbours :: Board -> Coord -> [Coord]
neighbours board c@(x,y) =
 filter (/= c) $ filter (inRange (bounds board)) [(x',y') | x' <- [x - 1..x + 1], y' <- [y - 1..y + 1]]
nextGen :: Board -> Board
nextGen board =
 let
 allCells = range (bounds board)
 takeState state coords = map fst . filter (\(_,s) -> s == state) $ zip coords (getStates board coords)
 livingNeighbours = length . takeState Alive . neighbours board
 zipState state coords = zip coords (repeat state)
 underPop = zipState Dead . filter (\c -> (livingNeighbours c) < 2) $ takeState Alive allCells
 overPop = zipState Dead .filter (\c -> (livingNeighbours c) > 3) $ takeState Alive allCells
 newBorn = zipState Alive .filter (\c -> (livingNeighbours c) == 3) $ takeState Dead allCells
 in setStates board (concat [underPop, overPop, newBorn])
evolve :: Board -> [Board]
evolve = iterate nextGen
toText :: Board -> T.Text
toText board = T.intercalate (T.singleton '\n') (rows minY)
 where
 ((minX,minY),(maxX,maxY)) = bounds board
 rows y
 | y > maxY = []
 | otherwise = (row y minX):rows (y + 1)
 row y x
 | x > maxX = T.empty
 | otherwise = T.cons (stateToChar $ board!(x,y)) (row y (x + 1))
 stateToChar state
 | state == Alive = '@'
 | otherwise = ' '

EDIT 2: nextGen implemented using do notation:

nextGen :: Board -> Board
nextGen board =
 let
 allCells = range (bounds board)
 takeState dstate coords = do
 coord <- coords
 let state = board ! coord
 guard $ state == dstate
 return (coord)
 theLiving = takeState Alive allCells
 theDead = takeState Dead allCells
 livingNeighbours = length . takeState Alive . neighbours board
 underPop = do
 alive <- theLiving
 guard $ (livingNeighbours alive) < 2
 return (alive,Dead)
 overPop = do
 alive <- theLiving
 guard $ (livingNeighbours alive) > 3
 return (alive,Dead)
 newBorn = do
 dead <- theDead
 guard $ (livingNeighbours dead) == 3
 return (dead,Alive)
 in setStates board (concat [underPop, overPop, newBorn])

Answer 1

First of all you should consider how you represent your board.

• Using Array with two-dimension index (Ix) would be a good choice for the way you work right now. You define value for each cell individually no matter what is in that cell.
• Alternative way is to use Map to () or Set of coordinates to represent Alive cells while treating rest of the board as Dead.
• Yet another is to use own container without even mentioning of coordinates.
  Consider the way how list ([a]) defined. That's actually a single-linked list. And you can create double-linked list like data DList a = DList DList a DList. In a same way you can define a double-linked grid (4 directions). Going further will let you define 5th dimension that represents generations.
  Such approach often used to represent lazy infinite structures that grow while you walk over them (ex. you walk around some cell and then dive into next generation and walk around again revealing how everythin were changed).
  I remember some term associated with that called "cellular automaton"

Next would be state (in case of Array and "cellular automaton")

Here you can define your own State just to make it clear, but you as well can use Bool. Note that it doesn't look like you need coordinates at all (consider dropping them from Cell).

Producing of new Map, Set, Array should be considered carefully I guess

One of the important thing is that its better to avoid producing of new board on each intermediate step (killing and reviving). I'd suggest to build up delta and then apply to original board. That should guard you from building almost similar copies of board.

Signatures

• It's a very common practice for update functions to take input as a last argument. I.e. setState :: State -> [Coord] -> Board -> Board. That allows to write something like: killTopLeft = setStates Dead [(0,0)]

Using high-order functions

evolve = iterate nextGen

And

setStates board state coords = Map.union updates board where
 updates = Map.fromList $ map (\c -> (c, Cell state c)) coords

• darwish: Thank you. I'm not sure I understand what you said about deltas. As far as I understand every object in Haskell is immutable, so even "applying deltas" productes a new copy of the object, doesn't it?
• ony: @darwish, yes there is no variables in the way as they present in other languages. But you can accumulate deltas in list which built a bit easier than Map and then update your original board with that list. Since you'll do build/modification from list library will be able to optimize somehow those operation to do them inplace (ex. convert list to array, sort it and rise a delta-Map from it).