Saturday 31 January 2015

Life by Comonads: 3

Conways game of life is a cellular automata - an environment with a synchronous update scheme. The status of the cell in the next time-step is decided by its current status and its environment. This makes it a perfect candidate for some comonadic power play. The rules are quite simple and you can find them online.
A cells status is simply that of dead or alive for which we will use booleans.
Deciding whether a cell is alive or dead in the next iteration will be a function of the form
decide :: Conway -> Bool 
In order to view the environment we need to be able to step up and down as well as the left and right we wrote previously.
This is where duplicate of the list zipper comes into play. A duplicated zipper will represent the environment.
type Conway = LZip (LZip Bool)
shiftU :: LZip (LZip Bool) -> LZip (LZip Bool)
shiftU = fmap shiftR
shiftD :: LZip (LZip Bool) -> LZip (LZip Bool)
shiftD = fmap shiftL

We can finally decide whether or not a cell stays alive for the next iteration by viewing the environment - We obtain a list of the status of the surrounding cells in 'doa', then count the ones alive and finally use that to determine its status according to the rules.

decide :: Conway -> Bool 
decide z | count < 2 = False 
         | count == 3 = True 
         | alive && count == 2 = True 
         | otherwise = False 
         where 
           alive = extract . extract $ z 
           count = if alive then count' - 1 else count'
           count' = foldl (\s b -> if b then (s+1) else s) 0 doa 
           doa = g <$> [shiftL, shiftR, id] <*> [shiftL, shiftR, id] 
           g s s' = case s' z of 
                        LZip _ z' _ -> extract (s z') 

The last piece is the decideLZip function. In order to extend the current state to get the new one we need a function that decides a column of the board for the given focus. 'decideColumn' must traverse the board vertically in order to decide the status of each of the cells in the column.

decideColumn :: Conway -> LZip Bool
decideColumn v = LZip l c r
  where 
    c = decide v
    l = fmap decide (tail $ iterate shiftD v)
    r = fmap decide (tail $ iterate shiftU v)

Finally our step function simply extends the current state using decideColumn.
step :: Conway -> Conway
step = extend decideColumn

We can then step the state as many times as we want by iteratively extending it with the step function.
The board at the nth time step would be (step^n) $ initial, according to the redefinition of (^) as defined below. We can pretty print the board in a certain neighborhood:
visual = (\c -> if c then 'o' else ' ')
pretty :: Int -> Conway -> [String]
pretty n c@(LZip l v r) = (map . map) visual b
    where
      b :: [[Bool]]
      b = crop2D n c
pp :: Int -> Conway -> IO ()
pp i c = mapM_ putStrLn (pretty i c)
_ ^ 0 = id
f ^ n = f . (f ^ (n-1))
And voila, thats the conway game of life modelled beautifully using commands.
A sample starting state - The Blinker - is presented below.

initial :: Conway
initial = LZip (repeat allFalses) blinker (repeat allFalses)
    where 
      allFalses = LZip (repeat False) False (repeat False)
      blinker = LZip (True:repeat False) True (True:repeat False)

No comments:

Post a Comment