7
\$\begingroup\$

I started with Haskell some months ago, but didn't really use it since then. As a simple training I implemented Conways game of life. What/How could it be improved?

module Main where

import Control.Monad.State

data CellState = Dead | Alive deriving (Eq)
data Cell = Cell CellState Int deriving (Eq)
data Row = Row [Cell] Int deriving (Eq)
data Grid = Grid [Row]
data NextError = EmptyListError

type GridState a = State Grid a

instance Show Grid where
        show (Grid rows) = unlines $ map show rows

instance Show Row where
        show (Row cells n) = (show n) ++ ": " ++ (unwords $ map show cells)

instance Show Cell where
        show (Cell color _) = show color

instance Show CellState where
        show c = case c of
                Dead -> "_"
                Alive -> "#"

main::IO()
main = print $ run (execState initializeGrid (createGrid 20 20)) 100

run :: Grid -> Int -> [Grid]
run g n = scanl (\s f -> f s) g $ replicate n playRound

initializeGrid :: GridState ()
initializeGrid = do
        setPositionToColor 0 0 Alive
        setPositionToColor 1 1 Alive
        setPositionToColor 1 2 Alive
        setPositionToColor 2 0 Alive
        setPositionToColor 2 1 Alive
        setPositionToColor 4 4 Alive
        setPositionToColor 5 4 Alive
        setPositionToColor 6 4 Alive
        setPositionToColor 5 5 Alive
        setPositionToColor 5 4 Alive
        setPositionToColor 5 6 Alive

createGrid :: Int -> Int -> Grid
createGrid x y = Grid $ map createRow (take x [0,1..]) where
                        createRow = Row (map createCell (take y [0,1..]))
                        createCell = Cell Dead

setPositionToColor :: Int -> Int -> CellState -> GridState ()
setPositionToColor x y color = do
        grid <- get
        let rows = getRows grid
            cells = getCells (rows !! x)
            newState = Grid $ replaceListElement rows x $ Row (replaceListElement cells y $ Cell color y) x
        put newState

getCells :: Row -> [Cell]
getCells (Row c _) = c

getRows :: Grid -> [Row]
getRows (Grid r) = r

replaceListElement :: [a] -> Int -> a -> [a]
replaceListElement list position replacement =
        let (x, _:xs) = splitAt position list
        in x ++ replacement : xs

playRound :: Grid -> Grid
playRound (Grid rows) = Grid $ map (updateRow rows) rows

updateRow :: [Row] -> Row -> Row
updateRow rows row@(Row cells p) = Row (map (updateCell rows row) cells) p

updateCell :: [Row] -> Row -> Cell -> Cell
updateCell rows row cell@(Cell _ position) =
        let upperRowCells = getCells $ previous rows row
            upperCell = upperRowCells !! position
            lowerRowCells = getCells $ next rows row
            lowerCell = lowerRowCells !! position
            neighbourCells = [upperCell, lowerCell] ++
                getNextPrevious (getCells row) cell ++
                getNextPrevious upperRowCells upperCell ++
                getNextPrevious lowerRowCells lowerCell
            countLivingNeighbours = length $ filter (==Alive) $ map getCellColor neighbourCells
            isLiving = getCellColor cell == Alive
        in Cell (calcCellState isLiving countLivingNeighbours) position

getCellColor :: Cell -> CellState
getCellColor (Cell c _) = c

calcCellState :: Bool -> Int -> CellState
calcCellState living livingNeighbours
        | living && livingNeighbours < 2 = Dead
        | living && livingNeighbours <= 3 = Alive
        | living && livingNeighbours > 3 = Dead
        | not living && livingNeighbours == 3 = Alive
        | otherwise = Dead

getNextPrevious :: Eq a => [a] -> a -> [a]
getNextPrevious l e = [next l e, previous l e]

next :: Eq a => [a] -> a ->  a
next l@(x:_) e = case dropWhile (/= e) l of
                   (_:y:_) -> y
                   _ -> x

previous :: Eq a => [a] -> a -> a
previous l e = case takeWhile (/=e) l of
                [] -> last l
                x -> last x
\$\endgroup\$
3
\$\begingroup\$

A few things which came to my mind while reading your code:

  • The Show instance for CellState might be a bit nicer by not writing out the case expression manually but rather using

    instance Show CellState where
        show Dead  = "_"
        show Alive = "#"
    
  • You could shorten initializeGrid by using mapM_:

    initializeGrid :: GridState ()
    initializeGrid = mapM_ (\(x, y) -> setPositionToColor x y Alive)
        [(0,0),(1,1),(1,2),(2,0),(2,1),(4,4),(5,4),(6,4),(5,5),(5,4),(5,6)]
    
  • take n [0,1..] is the same as [0,1..n] (looking at createGrid).

  • callCellState could be shortened by only explicitely testing the conditions determining whether the cell becomes (or remains) alive:

    calcCellState :: Bool -> Int -> CellState
    calcCellState living livingNeighbours
        | living && livingNeighbours `elem` [2,3] = Alive
        | not living && livingNeighbours == 3     = Alive
        | otherwise                               = Dead
    

On a more general note, seeing how long the updateCell function is and how you had to roll your own next and previous function I do suspect that lists are not the most appropriate data structure for this kind of problem. A vector may be easier to work with.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.