commit 451684e9283c2a3216dcb18d6e21b397fe9ac1c6 Author: Rnhmjoj Date: Fri Dec 19 20:02:47 2014 +0100 Initial commit diff --git a/life.hs b/life.hs new file mode 100644 index 0000000..f247092 --- /dev/null +++ b/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] + ]