stevenrwalter icon

Kata Game of Life

stevenrwalter | PRO | 11/25/13 01:54:06 PM UTC | 0 ⭐ | 205 👁️ | Never ⏰ | []
Haskell |

1.96 KB

|

None

|

0 👍

/

0 👎

import Data.List (nub)
 
type Coord = (Int, Int)
type Grid = [Coord]
 
alive :: Grid -> Coord -> Bool
alive grid coord = coord `elem` grid
 
data Cell = Alive | Dead deriving Eq
 
cellNextState :: Cell -> Int -> Cell
cellNextState Dead 3 = Alive
cellNextState Dead _ = Dead
 
cellNextState Alive neighbors
    | neighbors < 2 = Dead
    | neighbors > 3 = Dead
    | otherwise = Alive
 
adjacentCoords :: Coord -> [Coord]
adjacentCoords (x0,y0) = 
    [(x,y) | x <- [x0-1..x0+1], y <- [y0-1..y0+1]]
 
count p = length . filter p
 
countNeighbors :: Grid -> Coord -> Int
countNeighbors grid coord = 
    count (alive grid) $ filter (/= coord) $ adjacentCoords coord
 
nextGenCellAlive :: Grid -> Coord -> Bool
nextGenCellAlive grid coord =
    cellNextState cell (countNeighbors grid coord) == Alive
    where cell =
        if alive grid coord then Alive else Dead
 
nextGeneration :: Grid -> Grid
nextGeneration grid = 
    nub $ filter (nextGenCellAlive grid) consideredCoords
    where consideredCoords =
        nub $ concatMap adjacentCoords grid
 
readGrid :: String -> Int -> Int -> Grid
readGrid s 0 _ = []
readGrid s rows cols =
    readRow (take cols s) cols rows ++ readGrid (drop (cols+1) s) (rows-1) cols
 
readRow :: String -> Int -> Int -> Grid
readRow s 0 _ = []
readRow (x:xs) cols row =
    if x == '*' then
        readRow xs (cols-1) row ++ [(cols-1,row-1)]
    else
        readRow xs (cols-1) row
 
rowToStr :: Grid -> Int -> Int -> String
rowToStr g _ 0 = ""
rowToStr g row cols =
    char ++ rowToStr g row (cols-1)
    where char =
        if alive g (cols-1,row-1) then "*" else "."
 
gridToStr :: Grid -> Int -> Int -> [String]
gridToStr g 0 _ = []
gridToStr g rows cols =
    [rowToStr g rows cols] ++ gridToStr g (rows-1) cols
 
main = do
    header <- getLine
    s <- getContents
    let x = words header
    let rows = read (x !! 0)
    let cols = read (x !! 1)
    let grid = readGrid s rows cols
    putStrLn $ (show rows) ++ " " ++ (show cols)
    mapM_ putStrLn $ gridToStr (nextGeneration grid) rows cols

Comments