# 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)
> 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)
> 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.

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.

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.