Initial commit

life.hs

@@ -0,0 +1,76 @@
+{-#LANGUAGE TypeSynonymInstances, FlexibleInstances#-}
+import Data.Maybe (listToMaybe)
+import Data.List  (intercalate)
+
+data Mat a = Mat [[a]]
+type Pos  = (Int, Int)
+
+type Grid = Mat Cell
+type Cell = Int
+
+
+instance Functor Mat where
+  fmap f (Mat m) = Mat ((map . map) f m)
+
+instance Show Grid where
+  show (Mat m) = concatMap ((++"\n") . intercalate " " . map replace) m
+    where
+      replace 1 = "■"
+      replace 0 = "'"
+
+-- | Safely access a list
+-- [4,1,5,9] ?? 2 == Just 5
+-- [5,7] ?? 3 == Nothing
+(??) :: [a] -> Int -> Maybe a
+xs     ?? n | n < 0 =  Nothing
+[]     ?? _         =  Nothing
+(x:_)  ?? 0         =  Just x
+(_:xs) ?? n         =  xs ?? (n-1)
+
+-- | Create a Mat of Indeces for a grid
+indeces :: Grid -> Mat Pos
+indeces (Mat m) = Mat [[(x,y) | y <- [0..length (m !! x)-1]] |
+                                x <- [0..length m-1]]
+
+-- | Get the state of a cell
+-- 0 when out of the grid
+(!) :: Grid -> Pos -> Cell
+(Mat g) ! (x, y) = case g ?? y >>= (?? x) of
+  Nothing -> 0
+  Just v  -> v
+
+-- | Create empty grid
+void :: Int -> Int -> Grid
+void x y = Mat (replicate x $ replicate y 0)
+
+-- | Give the list of neighbours cells
+near :: Grid -> Pos -> [Cell]
+near g (x, y) = [g ! (x+x', y+y') | x' <- [-1..1],
+                                    y' <- [-1..1],
+                                   (x',y') /= (0,0)]
+
+-- | Find if a cell will be alive in the next generation
+alive :: Grid -> Pos -> Cell
+alive g p
+  | v == 0 && n == 3             = 1
+  | v == 1 && (n == 2 || n == 3) = 1
+  | otherwise                    = 0
+  where
+    (n, v) = (sum (near g p), g ! p)
+
+-- | Compute next generation
+next :: Grid -> Grid
+next g = fmap (alive g) (indeces g)
+
+main :: IO ()
+main = mapM_ print (iterate next grid)
+
+grid = Mat [
+    [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+  , [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0]
+  ]