Initial commit
This commit is contained in:
commit
451684e928
76
life.hs
Normal file
76
life.hs
Normal file
@ -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]
|
||||
]
|
Loading…
Reference in New Issue
Block a user