Skip to content

@edofic /Conway.hs
Last active

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
conway's game of life in haskell. inspired by a coderetreat event

test

runhaskell ConwayTests.hs

run

cat blinker.in > runhaskell Conway.hs

XXXXX
XXOXX
XXOXX
XXOXX
XXXXX
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
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.