api

.gitignore

@@ -6,3 +6,4 @@ Forest
 Brain
 SchereSteinPapier
 WireWorld
+doc/*

Brain.hs

@@ -3,7 +3,7 @@ import GUI
 
 main :: IO ()
 main = do
-    space <- randomSpace 50 50 [Ready, Firing, Refractory] :: IO (Torus Cell)
+    space <- randomSpace (50, 50) [Ready, Firing, Refractory] :: IO (Torus Cell)
     runCellularAutomata2D space [Ready, Firing, Refractory]
         colors (makeMoorRule (\self -> return . rule self))
 

CellularAutomata2D.hs

@@ -3,25 +3,25 @@ module CellularAutomata2D (
     Space(..),
     Torus(..),
     forSpace,
-    randomSpace, initSpaceWithCells, initSpaceWithDefault,
+    randomSpace, initSpaceWithCells, initIntSpaceWithCells,
     makeRuleWithNeighbors,
     makeMoorRule, makeNeumanRule,
     makeTotalMoorRule,
     choice) where
 
 import System.Random (randomRIO, Random)
-import Data.Array (listArray, bounds, indices, (!), Array, (//))
-import Control.Monad (replicateM, forM_, guard)
+import Data.Array (listArray, bounds, (!), Array, (//))
+import Control.Monad (forM_, guard)
 import Control.Applicative ((<$>))
 
 -- | A Rule is a function that returns a new cell value for a given cell coordinate in a given space.
 type Rule s a = s a -> (Int, Int) -> IO a
 
 class Space s where
     -- | Get a cell at a coordinate in the space.
-    getCell :: (Int, Int) -> s a -> a
+    getCell :: s a -> (Int, Int) -> a
     -- | Set a cell at a coordinate in the space to a new value.
-    setCell :: s a -> a -> (Int, Int) -> s a
+    setCell :: s a -> (Int, Int) -> a -> s a
     -- | Get the dimensions of the space.
     getSpaceSize :: s a -> (Int, Int)
     -- | Initializes the space using a given function that takes a coordinate
@@ -36,7 +36,7 @@ class Space s where
     -- This function has a default implementation in terms of setCell
     -- but it might be specialized for performence purposes.
     setCells :: s a -> [((Int, Int), a)] -> s a
-    setCells = foldl (\s c -> setCell s (snd c) (fst c))
+    setCells = foldl (\s (i, v) -> setCell s i v)
 
     -- | Updates a given space by one generation using a given rule.
     update :: s a -> Rule s a -> IO (s a)
@@ -47,9 +47,9 @@ class Space s where
 newtype Torus a = Torus (Array (Int, Int) a) deriving (Show, Eq)
 
 instance Space Torus where
-    getCell (row, col) (Torus a) = a ! (row `mod` h, col `mod` w)
+    getCell (Torus a) (row, col) = a ! (row `mod` h, col `mod` w)
         where (h, w) = getSpaceSize (Torus a)
-    setCell (Torus space) cell index = Torus $ space // [(index, cell)]
+    setCell (Torus space) index cell = Torus $ space // [(index, cell)]
     setCells (Torus space) cells = Torus $ space // cells
     getSpaceSize (Torus space) = (maxRow + 1, maxCol + 1)
         where (_, (maxRow, maxCol)) = bounds space
@@ -66,27 +66,27 @@ forSpace :: Space s => s a -> ((Int, Int) -> a -> IO ()) -> IO ()
 forSpace space fn =
     forM_ [0..spaceHeight - 1] $ \row ->
         forM_ [0..spaceWidth - 1] $ \col ->
-            fn (row, col) (getCell (row, col) space)
+            fn (row, col) (getCell space (row, col))
     where (spaceHeight, spaceWidth) = getSpaceSize space
 
 ------------------- creating spaces -----------------
 -- | Initializes a space of a given shape using a list of possible cells.
 -- Each cell is randomly choosen from the list.
 -- You might want to duplicate elements in the list to ajust the frequencys
 -- (probability to be choosen) of the cell values.
-randomSpace :: Space s => Int -> Int -> [a] -> IO (s a)
-randomSpace height width cellStateDist = initSpaceIO (height, width) $ \_ ->
+randomSpace :: Space s => (Int, Int) -> [a] -> IO (s a)
+randomSpace (height, width) cellStateDist = initSpaceIO (height, width) $ \_ ->
     (cellStateDist !!) <$> randomRIO (0, length cellStateDist - 1)
 
 -- | Initializes a space with a default background cell value and a few cells
 -- at given coordinates with individual values.
-initSpaceWithDefault :: Space s => a -> Int -> Int -> [((Int, Int), a)] -> s a
-initSpaceWithDefault defaultValue spaceWidth spaceHeight initCells =
-    setCells (initSpace (spaceHeight, spaceWidth) (const defaultValue)) initCells
+initSpaceWithCells :: Space s => (Int, Int) -> a -> [((Int, Int), a)] -> s a
+initSpaceWithCells (spaceWidth, spaceHeight) defaultValue =
+    setCells (initSpace (spaceHeight, spaceWidth) (const defaultValue))
 
 -- | Specialized version of initSpaceWithDefault for int spaces with 0 as the background.
-initSpaceWithCells :: Space s => Int -> Int -> [((Int, Int), Int)] -> s Int
-initSpaceWithCells = initSpaceWithDefault (0 :: Int)
+initIntSpaceWithCells :: Space s => (Int, Int) -> [((Int, Int), Int)] -> s Int
+initIntSpaceWithCells = flip initSpaceWithCells (0 :: Int)
 
 --------------------- updating and rules ----------------
 -- | Creates a rule from a function witch takes the cell value and a list of neightbors and
@@ -96,8 +96,8 @@ initSpaceWithCells = initSpaceWithDefault (0 :: Int)
 makeRuleWithNeighbors :: Space s => [(Int, Int)] -> (a -> [a] -> IO a) -> Rule s a
 makeRuleWithNeighbors neighborhoodDeltas ruleWithNeighbors
                       space (row, col) = ruleWithNeighbors self friends
-    where self = getCell (row, col) space
-          friends = map (\(dr, dc) -> getCell (row + dr, col + dc) space) neighborhoodDeltas
+    where self = getCell space (row, col)
+          friends = map (\(dr, dc) -> getCell space (row + dr, col + dc)) neighborhoodDeltas
 
 makeMoorRule, makeNeumanRule :: Space s => (a -> [a] -> IO a) -> Rule s a
 -- ^ Specialized version of makeRuleWithNeighbors for the Moor neightborhood.

Forest.hs

@@ -6,7 +6,7 @@ data Wood = Tree | Empty | Fire deriving (Show, Eq)
 
 main :: IO ()
 main = do
-    space <- randomSpace 150 150 [Empty, Tree] :: IO (Torus Wood)
+    space <- randomSpace (150, 150) [Empty, Tree] :: IO (Torus Wood)
     runCellularAutomata2D space [Tree, Empty, Fire] colors
         (makeMoorRule updateCell)
 

GUI.hs

@@ -84,8 +84,8 @@ loop state = do
         Quit -> SDL.quit
         Insert x y ->
             let cellIndex = (y `div` cellSize state, x `div` cellSize state) in
-                          loop state { _space = setCell (_space state)
-                            (next (getCell cellIndex $ _space state)) cellIndex }
+                          loop state { _space = setCell (_space state) cellIndex
+                            (next (flip getCell cellIndex $ _space state)) }
         NextColor -> loop state { accColor = (accColor state + 1) `mod`
             length (possibleStates state) }
         StartStop -> loop state { running = not (running state) }

GameOfLife.hs

@@ -12,7 +12,7 @@ gol :: Space s => s Int -> IO ()
 gol space = runCellularAutomata2D space [0,1] ([black, white] !!) golRule
 
 glieder :: Torus Int
-glieder = initSpaceWithCells 20 20
+glieder = initIntSpaceWithCells (20, 20)
     (zip [(0,2),(1,2),(2,2),(2,1),(1,0)] (repeat 1))
 
 golRule :: Space s => Rule s Int

NAND.hs

@@ -19,16 +19,16 @@ main = do
 
 logicSpace :: Bool -> Bool -> Bool -> IO ()
 logicSpace isAnd isMoor withSelf = do
-    space <- randomSpace 50 50 [True, False] :: IO (Torus Bool)
-    -- let space = initSpaceWithDefault False 50 50 [] :: Torus Bool
+    space <- randomSpace (50, 50) [True, False] :: IO (Torus Bool)
+    -- let space = initSpaceWithDefault False (50, 50) [] :: Torus Bool
     let ruleMaker = if isMoor then makeMoorRule else makeNeumanRule
     let logicFn = if isAnd then and else or
     let rule = ruleMaker (\self ns -> return $ not $ logicFn (if withSelf then self:ns else ns))
     runCellularAutomata2D space [True, False] colors rule
 
 asymNANDSpace :: IO ()
 asymNANDSpace = do
-    space <- randomSpace 50 50 [True, False] :: IO (Torus Bool)
+    space <- randomSpace (50, 50) [True, False] :: IO (Torus Bool)
     runCellularAutomata2D space [True, False] colors $ makeMoorRule $ \self ns ->
         return $ not $ and $ self : take 3 ns
 colors :: Bool -> Color

RockPaperScissors.hs

@@ -3,7 +3,7 @@ import GUI
 
 main :: IO ()
 main = do
-    let space = initSpaceWithDefault (Cell White maxLives) 50 50 [] :: Torus Cell
+    let space = initSpaceWithCells (50, 50) (Cell White maxLives) [] :: Torus Cell
     runCellularAutomata2D space
         (map (flip Cell maxLives) [Red, Green, Blue, White])
         colors (makeMoorRule updateCell)

WireWorld.hs

@@ -6,7 +6,7 @@ data Cell = Empty | Conductor | ElectronHead | ElectronTail
 
 main :: IO ()
 main = runCellularAutomata2D
-    (initSpaceWithDefault Empty 50 50 [] :: Torus Cell)
+    (initSpaceWithCells (50, 50) Empty [] :: Torus Cell)
     [minBound..maxBound]
     (([grey, yellow, blue, red] !!) . fromEnum)
     wireWorldRule

doc.sh

@@ -0,0 +1,13 @@
+
+
+haddock CellularAutomata2D.hs -h -o doc
+haddock GUI.hs -h -o doc
+haddock Term.hs -h -o doc
+haddock Brain.hs -h -o doc
+haddock Forest.hs -h -o doc
+haddock GameOfLife.hs -h -o doc
+haddock NAND.hs -h -o doc
+haddock RockPaperScissors.hs -h -o doc
+haddock WireWorld.hs -h -o doc
+
+