Comonads, Life and Klein Bottles

It’s part of Haskell folklore that the archetypal example for comonads is Conway’s game of life. Here’s an implementation using arrays.

> {-# OPTIONS_GHC -Wall                    #-}
> {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
> {-# OPTIONS_GHC -fno-warn-type-defaults  #-}

> import Diagrams.Prelude
> import Diagrams.Backend.Cairo.CmdLine
> import Data.Array
> import Data.List

The usual comonad class:

> class Comonad c where
>   coreturn :: c a -> a
>   (=>>) :: c a -> (c a -> b) -> c b

This will become our two dimensional grid when we concretize it.

> data PointedArray i a = PointedArray i (Array i a)
>   deriving Show

As usual we make this into a functor by using the functor instance of the underlying array.

> instance Ix i => Functor (PointedArray i) where
>   fmap f (PointedArray i a) = PointedArray i (fmap f a)

An array with a distinguished element is a comonad in which the cobind updates each element of the array simultaneously.

> instance Ix i => Comonad (PointedArray i) where
>   coreturn (PointedArray i a) = a!i
>   (PointedArray i a) =>> f =
>     PointedArray i (listArray (bounds a)
>                    (map (f . flip PointedArray a) (range $ bounds a)))

Let’s have a small grid size to demonstrate the so called glider.

> mMax, nMax :: Int
> mMax = 5
> nMax = 5

A cell is either dead or alive.

> data Liveness =
>   Dead | Alive
>   deriving (Eq, Show)

Let’s be explicit about our neighbours.

> data Neighbours a = Neighbours { north     :: a
>                                , northEast :: a
>                                , east      :: a
>                                , southEast :: a
>                                , south     :: a
>                                , southWest :: a
>                                , west      :: a
>                                , northWest :: a
>                                }
>                   deriving Show
> 
> toList :: Neighbours a -> [a]
> toList (Neighbours x1 x2 x3 x4 x5 x6 x7 x8) = x1:x2:x3:x4:x5:x6:x7:x8:[]
> 
> type NumNeighbours a = Int -> Int -> PointedArray (Int, Int) a
>                        -> Neighbours a
> 
> numNeighbours :: NumNeighbours Liveness
>                  -> PointedArray (Int, Int) Liveness
>                  -> Int
> numNeighbours ns p = length $
>                      filter (== Alive) $
>                      toList $
>                      ns mMax nMax p

Now we can implement the rules.

> f :: NumNeighbours Liveness ->
>      PointedArray (Int, Int) Liveness ->
>      Liveness
> f ns p@(PointedArray (i, j) x)
>   |  x!(i, j) == Alive && (numNeighbours ns p < 2)
>   = Dead
> f ns p@(PointedArray (i, j) x)
>   |  x!(i, j) == Alive && (numNeighbours ns p `elem` [2, 3])
>   = Alive
> f ns p@(PointedArray (i, j) x)
>   |  x!(i, j) == Alive && (numNeighbours ns p > 3)
>   = Dead
> f ns p@(PointedArray (i, j) x)
>   |  x!(i, j) == Dead && (numNeighbours ns p == 3)
>   = Alive
> f _  (PointedArray (i, j) x)
>   = x!(i, j)

Let’s create a glider which will move around our manifold.

> glider :: PointedArray (Int, Int) Liveness
> glider = PointedArray (0, 0) xs
>   where
>     ys = listArray ((0, 0), (mMax - 1, nMax - 1)) $ repeat Dead
>     xs = ys // [ ((2, 4), Alive)
>                , ((3, 3), Alive)
>                , ((1, 2), Alive)
>                , ((2, 2), Alive)
>                , ((3, 2), Alive)
>                ]

We can’t have an infinite grid with an array but we can make our game of life take place on a torus rather than the plane. This way we don’t have problems with boundary conditions.

> neighbours :: Int -> Int -> PointedArray (Int, Int) a -> Neighbours a
> neighbours mMax nMax (PointedArray (i, j) x) =
>   Neighbours
>     {
>       north     = x!(i,                  (j + 1) `mod` nMax)
>     , northEast = x!((i + 1) `mod` mMax, (j + 1) `mod` nMax)
>     , east      = x!((i + 1) `mod` mMax, j)
>     , southEast = x!((i + 1) `mod` mMax, (j - 1) `mod` nMax)
>     , south     = x!(i,                  (j - 1) `mod` nMax)
>     , southWest = x!((i - 1) `mod` mMax, (j - 1) `mod` nMax)
>     , west      = x!((i - 1) `mod` mMax, j)
>     , northWest = x!((i - 1) `mod` mMax, (j + 1) `mod` nMax)
>     }

We can see that the glider reappears at the same place at iterations 21 and 41.

55ce7cfc4851d7d9d3f990a3a006c292

We don’t have to use a torus. For example, we can use a Klein bottle which is non-orientable surface.

> neighboursKlein :: Int -> Int -> PointedArray (Int, Int) a
>                    -> Neighbours a
> neighboursKlein mMax nMax (PointedArray (i, j) x) =
>   Neighbours
>     {
>       north     = north' i j
>     , northEast = northEast' i j
>     , east      = x!((i + 1) `mod` mMax, j)
>     , southEast = southEast' i j
>     , south     = south' i j
>     , southWest = southWest' i j
>     , west      = x!((i - 1) `mod` mMax, j)
>     , northWest = northWest' i j
>     }
>   where
>     north'     i j
>       | j < nMax - 1 = x!(i,                                j + 1)
>       | otherwise    = x!(mMax - 1 - i,                         0)
>     northEast' i j
>       | j < nMax - 1 = x!((i + 1) `mod` mMax,               j + 1)
>       | otherwise    = x!(mMax - 1 - (i + 1) `mod` mMax,        0)
>     southEast' i j
>       | j > 0        = x!((i + 1) `mod` mMax,               j - 1)
>       | otherwise    = x!(mMax - 1 - (i + 1) `mod` mMax, nMax - 1)
>     south'     i j
>       | j > 0        = x!(i,                                j - 1)
>       | otherwise    = x!(mMax - 1 - i,                  nMax - 1)
>     southWest' i j
>       | j > 0        = x!((i - 1) `mod` mMax,               j - 1)
>       | otherwise    = x!(mMax - 1 - (i - 1) `mod` mMax, nMax - 1)
>     northWest' i j
>       | j < nMax - 1 = x!((i - 1) `mod` mMax,               j + 1)
>       | otherwise    = x!(mMax - 1 - (i - 1) `mod` mMax,        0)

We can see that the glider reappears in the same place at iteration 21 with its left and right sides swapped and that it reappears in the same place at iteration 41 with its original handedness.

46bd694699c10c72ec955a745137e898

If you wish to run the code yourself, you will need to do something like this:

> testGrids :: [PointedArray (Int, Int) Liveness]
> testGrids = take 10 $ iterate (=>> (f neighbours)) glider

It is somewhat difficult to determine what is going on from the raw data structures themselves; it is easier to see what is happening using some form of diagram. If you wish to do this, the full code and text are available here.

About these ads

One thought on “Comonads, Life and Klein Bottles

  1. Pingback: Haskell, Ising, Markov & Metropolis | Idontgetoutmuch’s Weblog

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s