runhaskell ConwayTests.hs
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 |