2017-08-04 90 views
3

我已經使用Store comonad編寫了Conway's Game of Life的簡單實現(請參閱下面的代碼)。我的問題是,從第五次迭代開始,網格生成速度明顯變慢。我的問題與我使用Store comonad的事實有關嗎?還是我犯了一個明顯的錯誤?據我所知,基於Zipper comonad的otherimplementations是高效的。使用商店comonad表現康威的生活遊戲

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 [email protected](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 

回答

4

商店comonad本身並沒有真正存儲任何東西(除了在抽象意義上的功能是一個「容器」),但從頭開始計算它。在幾次迭代中,這顯然非常低效。

你可以不改變你的代碼,雖然緩解這個,如果你只是備份s -> a功能與some memoisation

import Data.MemoTrie 

instance HasTrie s => Functor (Store s) where 
    fmap f (Store g s) = Store (memo $ f . g) s 

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

沒有測試是否真的給可接受的性能。

+0

謝謝!建議的更改按預期工作。 –