Commit 0a80465b authored by Nicolas Lenz's avatar Nicolas Lenz
Browse files

A first working version

parent 99a26590
......@@ -21,4 +21,4 @@ cabal.project.local
cabal.project.local~
.HTF/
.ghc.environment.*
.vscode
module GameOfLife where
import Data.Maybe
data Cell = Dead | Alive deriving (Show)
data Pos = Pos {posX :: Int, posY :: Int} deriving (Show, Eq)
data Board = Board [[Cell]] deriving (Show)
data Ruleset = Ruleset [Int] [Int]
-- ---> x
-- |
-- V
-- y
testBoard :: Board
testBoard = Board [[Dead, Alive, Dead],
[Alive, Alive, Dead],
[Dead, Dead, Alive]]
isAlive :: Cell -> Bool
isAlive Alive = True
isAlive Dead = False
-- | Safe index operator using Maybe. Returns Just the n-th element of the list if the index is valid, else Nothing.
(!?) :: [a] -> Int -> Maybe a
(x:xs) !? 0 = Just x
(x:xs) !? n | n > 0 = xs !? (n - 1)
_ !? _ = Nothing -- The list is empty or the index negative, so return Nothing.
map2 :: (a -> b) -> [[a]] -> [[b]]
map2 f = map (map f)
getCell :: Board -> Pos -> Maybe Cell
getCell (Board css) (Pos x y) = (css !? x) >>= (!? y)
allPos :: Board -> [Pos]
allPos (Board []) = []
allPos (Board [[]]) = []
allPos (Board css)= [Pos x y | x <- [0 .. length css], y <- [0 .. length $ head css]]
neighborsPos :: Pos -> [Pos]
neighborsPos (Pos x y) = [Pos x' y' | x' <- [x - 1..x + 1], y' <- [y - 1..y + 1], not $ (x' == x) && (y' == y)]
neighbors :: Board -> Pos -> [Cell]
neighbors board pos = catMaybes $ (getCell board) <$> neighborsPos pos -- , not $ (x' == x) && (y' == y), x >= 0, y >= 0, x < length cs, y < length (head cs)]
neighborCount :: Board -> Pos -> Int
neighborCount board = length . (filter isAlive) . (neighbors board)
newState :: Ruleset -> Int -> Cell -> Cell
newState (Ruleset born surv) neighborCount Alive
| neighborCount `elem` surv = Alive
| otherwise = Dead
newState (Ruleset born surv) neighborCount Dead
| neighborCount `elem` born = Alive
| otherwise = Dead
transition :: Ruleset -> Board -> Board
transition ruleset (Board css) = undefined
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.34.4.
--
-- see: https://github.com/sol/hpack
name: game-of-life
version: 0.0.0
license: Apache-2.0
license-file: LICENSE
build-type: Simple
executable game-of-life
main-is: Main.hs
other-modules:
Paths_game_of_life
hs-source-dirs:
src
ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
build-depends:
array
, base
, split
default-language: Haskell2010
name: game-of-life
license: Apache-2.0
dependencies:
- base
- array
- split
executables:
game-of-life:
main: Main.hs
source-dirs: src
ghc-options:
- -O2
- -threaded
- -rtsopts
- -with-rtsopts=-N
module Main where
import Data.Array
import Data.List (intercalate)
import Data.List.Split (divvy)
import Control.Concurrent (threadDelay)
data Cell = Dead | Alive
instance (Show Cell) where
show Dead = "_ "
show Alive = "O "
data Board = Board { cells :: (Array Pos Cell) }
instance (Show Board) where
show (Board cells) = intercalate "\n" cellRows where
(Pos _ _, Pos _ maxX) = bounds cells
cellStrings = show <$> elems cells :: [String]
cellStringRows = divvy (maxX + 1) (maxX + 1) cellStrings :: [[String]]
cellRows = concat <$> cellStringRows :: [String]
{-
The coordinate system is oriented like this:
+---> x
|
V
y
-}
data Pos = Pos
{ posY :: Int
, posX :: Int
} deriving (Show, Eq, Ord, Ix)
-- | A ruleset for a game of life world.
data Ruleset = Ruleset
[Int] -- ^ amount of neighbors of an alive cell which will let it survive
[Int] -- ^ amount of neighbors of a dead cell which will let it be born anew
-- | The classic Conway world ruleset (23/3):
-- A alive cell will survive with two or three neighbors
-- and a dead cell will be born anew with three neigbors.
conway :: Ruleset
conway = Ruleset [2,3] [3]
-- | Computes the new state of a cell with some amount of neighbors.
newState :: Ruleset -> Int -> Cell -> Cell
newState (Ruleset surv born) neighborCount Alive
| neighborCount `elem` surv = Alive
| otherwise = Dead
newState (Ruleset surv born) neighborCount Dead
| neighborCount `elem` born = Alive
| otherwise = Dead
countAlive :: [Cell] -> Int
countAlive [] = 0
countAlive (Alive:xs) = 1 + countAlive xs
countAlive (Dead:xs) = countAlive xs
transitionCell :: Ruleset -> Board -> Pos -> Cell
transitionCell ruleset (Board cells) pos
= newState ruleset (countAlive $ (cells !) <$> neighborsPos (bounds cells) pos) (cells ! pos)
transition :: Ruleset -> Board -> Board
transition ruleset (Board cells) = Board
$ listArray (bounds cells) (transitionCell ruleset (Board cells) <$> indices cells)
neighborsPos :: (Pos, Pos) -> Pos -> [Pos]
neighborsPos (Pos minY minX, Pos maxY maxX) pos = shiftPos pos <$> neighborShifts where
shiftPos :: Pos -> (Int, Int) -> Pos
shiftPos (Pos y x) (shiftY, shiftX) = Pos ((y + shiftY) `mod` maxY) ((x + shiftX) `mod` maxX)
neighborShifts :: [(Int, Int)]
neighborShifts = [(-1, 1), (0, 1), (1, 1), (-1, 0), (1, 0), (-1, -1), (0, -1), (1, -1)]
-- A trivial test board: the oscillating blinker object
testBoard :: Board
testBoard = Board $ listArray (Pos 0 0, Pos 4 4)
[ Dead, Dead, Dead, Dead, Dead
, Dead, Dead, Dead, Dead, Dead
, Dead, Alive, Alive, Alive, Dead
, Dead, Dead, Dead, Dead, Dead
, Dead, Dead, Dead, Dead, Dead
]
main :: IO ()
main = loop testBoard where
loop board = do
print board
putStrLn ""
threadDelay 500000
loop (transition conway board)
resolver: lts-18.17
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
snapshots:
- original: lts-18.17
completed:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/17.yaml
sha256: e66e70a7f998036025e8f40abc89b8eeb79c88f57727020cba1b54f375aa7ca0
size: 586292
packages: []
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment