conway's game of life in haskell. inspired by a coderetreat event

README.md

test

runhaskell ConwayTests.hs

run

cat blinker.in > runhaskell Conway.hs

blinker.in

XXXXX
XXOXX
XXOXX
XXOXX
XXXXX

Conway.hs

module Conway where

import qualified Data.Set as Set
import Control.Concurrent (threadDelay)

type Entry = (Integer, Integer)

newtype Field = Field { getField :: (Set.Set Entry) } deriving Eq

emptyField :: Field
emptyField = Field Set.empty

parseField :: String -> Field
parseField raw = Field $ Set.fromList filtered where
  parseLine (line, x) = zip (map (=='O') line) [(y,x) | y <- [0..]]
  indexed = (zip (lines raw) [0..]) >>= parseLine
  filtered = [xy | (live, xy) <- indexed, live]

instance Show Field where
  show (Field set) = let
    (xs,ys) = unzip $ Set.elems set
    cell x y = if Set.member (x,y) set then 'O' else 'X' 
    in unlines $ [[cell x y | x <- [minimum xs..maximum xs]] | y <- [minimum ys..maximum ys]]

isAlive :: Field -> Entry -> Bool
isAlive (Field set) k = Set.member k set

neighbourIndices :: Entry -> [Entry]
neighbourIndices (x,y) = [(x+dx,y+dy) | dx <- [-1..1], dy <- [-1..1], not (dx == 0 && dy ==0)]

neighbourCount :: Field -> Entry -> Int
neighbourCount field = length . filter (isAlive field) . neighbourIndices

willBeAlive :: Field -> Entry -> Bool
willBeAlive field entry = (count == 3) || (alive && (count == 2)) where
  count = neighbourCount field entry
  alive = isAlive field entry

step :: Field -> Field
step field = Field (Set.fromList indices) where 
  candidates = Set.elems (getField field) >>= neighbourIndices
  indices = filter (willBeAlive field) candidates

main :: IO ()
main = getContents >>= (loop . parseField) where
  loop field = do
    print field
    threadDelay 500000
    loop $ step field

ConwayTests.hs

module Tests where

import Conway hiding (main)
import Test.HUnit

fieldBox = parseField "XXXX\nXOOX\nXOOX\nXXXX\n"

fieldBlinker1 = parseField "XXXXX\nXXOXX\nXXOXX\nXXOXX\nXXXXX"
fieldBlinker2 = parseField "XXXXX\nXXXXX\nXOOOX\nXXXXX\nXXXXX"

testConstructEmpty = assertEqual "construct empty field" emptyField parsed where
  parsed = parseField ""

testConstructNonEmpty = assertEqual "construct non-empty field" raw str where
  raw = "XO\nOX\n"
  str = show $ parseField raw

testLiveness = do
  assertEqual "dead cell" False (isAlive fieldBox (0,0)) 
  assertEqual "live cell" True (isAlive fieldBox (1,1)) 

testNeighbourCount = do
  assertEqual "box corner" 1 (neighbourCount fieldBox (0,0)) 
  assertEqual "box mid" 3 (neighbourCount fieldBox (1,1)) 

testWillBeAlive = do
  assertEqual "box corner" False (willBeAlive fieldBox (0,0)) 
  assertEqual "box mid" True (willBeAlive fieldBox (1,1)) 
  assertEqual "blinker mid" True (willBeAlive fieldBlinker1 (2,2)) 
  assertEqual "blinker left mid" True (willBeAlive fieldBlinker1 (1,2)) 
  assertEqual "blinker top mid" False (willBeAlive fieldBlinker1 (2,1)) 

testBlink = do
  assertEqual "blink 1->2" fieldBlinker2 (step fieldBlinker1)
  assertEqual "blink 2->1" fieldBlinker1 (step fieldBlinker2)

assertions = [testConstructEmpty 
             ,testConstructNonEmpty
             ,testLiveness
             ,testNeighbourCount
             ,testWillBeAlive
             ,testBlink
             ]

tests = TestList $ fmap TestCase assertions

main = runTestTT tests