Performance of Conway's Game of Life using the Store comonad

Viewed 858

I've written a simple implementation of Conway's Game of Life using the Store comonad (see code below). My problem is that the grid generation is getting visibly slower from the fifth iteration onwards. Is my issue related to the fact that I'm using the Store comonad? Or am I making a glaring mistake? As far as I could tell, other implementations, which are based on the Zipper comonad, are efficient.

import Control.Comonad

data Store s a = Store (s -> a) s

instance Functor (Store s) where
    fmap f (Store g s) = Store (f . g) s

instance Comonad (Store s) where
    extract (Store f a) = f a
    duplicate (Store f s) = Store (Store f) s

type Pos = (Int, Int)

seed :: Store Pos Bool
seed = Store g (0, 0)
    where
        g ( 0,  1) = True
        g ( 1,  0) = True
        g (-1, -1) = True
        g (-1,  0) = True
        g (-1,  1) = True
        g _        = False

neighbours8 :: [Pos]
neighbours8 = [(x, y) | x <- [-1..1], y <- [-1..1], (x, y) /= (0, 0)]

move :: Store Pos a -> Pos -> Store Pos a
move (Store f (x, y)) (dx, dy) = Store f (x + dx, y + dy)

count :: [Bool] -> Int
count = length . filter id

getNrAliveNeighs :: Store Pos Bool -> Int
getNrAliveNeighs s = count $ fmap (extract . move s) neighbours8

rule :: Store Pos Bool -> Bool
rule s = let n = getNrAliveNeighs s
        in case (extract s) of
            True  -> 2 <= n && n <= 3
            False -> n == 3

blockToStr :: [[Bool]] -> String
blockToStr = unlines . fmap (fmap f)
    where
        f True  = '*'
        f False = '.'

getBlock :: Int -> Store Pos a -> [[a]]
getBlock n store@(Store _ (x, y)) =
    [[extract (move store (dx, dy)) | dy <- yrange] | dx <- xrange]
    where
        yrange = [(x - n)..(y + n)]
        xrange = reverse yrange

example :: IO ()
example = putStrLn
        $ unlines
        $ take 7
        $ fmap (blockToStr . getBlock 5)
        $ iterate (extend rule) seed
1 Answers
Related