This post is late, the season has passed, and I am writing this in one of the least Christmasy places. Yet I like this little diversion so much that I’ll share it with you. Just look at how heart-warming this looks.

If you’re in the midst of a paper crisis, one of the best ways to procrastinate is to learn something you haven’t got around to for ages and doesn’t in any way contribute towards your paper. In my case, this was comonads.

It’s not that I didn’t know what comonads were. They are the dual concept of monads in category theory, but this sort of lost its meaning once I realised I don’t know what a monad is.

After some digging and head-scratching, I realised comonads are good for
computing from a *context*. In comonad explanations, you often find zippers,
multi-dimensional arrays, and streams as example instances, used in everything
from cellular automata to dataflow analysis. In this post, we focus on zippers
to implement cellular automata.

Below, we first give an overview of the comonad typeclass in Haskell and write out the instance for zippers. Then using the primitives of the typeclass, we build a blinking Christmas tree and briefly look at a way of displaying it finitely.

## Comonad typeclass primer

Although hearing comonads are the dual of monads at a categorical level didn’t
help me conceptually, it helps me remember the signatures of its primitives.
For `return`

, `bind`

, and `join`

of monads, there are `coreturn`

, `cobind`

, and
`cojoin`

in comonads. The function arrows in the signature of these functions
are helpfully reversed. As one might expect, we can define `cobind`

in terms of
`cojoin`

. This is what they mean when they say comonads are just the dual
concept of monads, though without further explanation it is not as helpful as
some think! These functions are also given different names in Haskell,
`extract`

, `extend`

, and `duplicate`

respectively. Whether these names make the
concept clearer or more confusing is a source of lively discussions.

```
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> w a -> w b
= fmap f (duplicate cm) extend f cm
```

I know the definition is not terribly exciting after I gave it away in the
explanation. Perhaps the interesting bit is the simple definition of `extend`

in
terms of `duplicate`

. In particular, `f`

in `extend`

does some form of
*reduction* from the *context* and this is applied over `duplicate`

of a comonad
instance. Intuitively, `extend`

’s job is to use `f`

to compute new focus
points. This implies that `duplicate`

’s function is to encapsulate the instance
within itself with different points in focus.

OK. I know. That explanation was less than intuitive. Let’s see an instance
instead. The data structure of interest today is a *zipper*. You can think of it
as a list with a focus^{1}. It is defined along with helpful functions to
change the focus point.

```
data Zipper a = Zipper [ a ] a [ a ] deriving Functor
right :: Zipper a -> Zipper a
left,Zipper (l:ls) a rs) = Zipper ls l (a:rs)
left (Zipper ls a (r:rs)) = Zipper (a:ls) r rs right (
```

The middle parameter is the focus point and we have bunch of elements to the
left and right. We’ll use zippers with infinite number of elements, but there
isn’t a fundamental reason that has to be the case elsewhere. So you can think
of a zipper as an infinite tape with a focus and `left`

& `right`

functions as
shifting the tape.

Let’s get to the comonad instance for `Zipper`

. The `extract`

function is
pleasingly dull and extracts the focus of the zipper. The `duplicate`

function
is slightly more interesting. It makes shifted copies of the zipper in a zipper
where the number of shifts is determined by the direction and distance from the
focus point of the enclosing zipper^{2}.

```
instance Comonad Zipper where
Zipper _ a _) = a
extract (= Zipper (tail $ iterate left u) u (tail $ iterate right u) duplicate u
```

If you’re still unsure about zippers and comonads there are better explanations of them than that of mine (such as those by Dan Piponi and Bartosz Milewski) which you can jump in before coming back for the Christmas tree. Also I am too cheap to discuss the laws that needs to be satisfied by a comonad instance as they are not enforcable by the Haskell type system. This might be another reason to check other tutorials.

## Cellular automata for Christmas tree

Now that we are equipped with the full power of comonads, we can proceed to animate a Christmas tree—admittedly, an underwhelming use case.

We will use two cellular automata. First to grow the tree and then another to make it blink. We need an initial configuration to start the whole process and as promised, it is a single dot on an infinite tape.

`= Zipper (repeat 0) 1 (repeat 0) initConf `

Any respectable Christmas tree would have at least two dimensions and this
zipper represents only the top of the tree. We heighten it by evolving this
initial configuration via the reduction `grow`

and stack the generations one
below the other^{3}.

```
grow :: Zipper Int -> Int
Zipper (l:_) a (r:_)) = if l == r then 0 else 1 grow (
```

Here `grow`

’s type signature corresponds exactly to that expected by the
`extend`

function. Functionally, it is the XOR of the left and right
neighbours^{4}.

If you evolve some number of generations, stack successive generations one after
another, and print it on your terminal, you obtain a fine looking ASCII tree. In
each generation, the farthest left and right `1`

-cells have one farther
`0`

-cell. This cell, then, has a `0`

-cell and a `1`

-cell as its neighbours. In
the next generation, these `0`

-cells become `1`

-cells and we get a triangular
shape for stacking configurations. In a terminal, since the height of a letter
is often longer than its width, we get a nice top angle suitable for a tree.

Now that we have a tree (of infinite height), we can focus on making it blink
using the `blink`

reduction.

```
blink :: Zipper Int -> Int
Zipper _ 0 _) = 0
blink (Zipper (l1:l2:_) a (r1:r2:_)) = 1 + (l1 + l2 + a + r1 + r2) `mod` 3 blink (
```

It is constructed so that `0`

is treated as dead space and maps to itself
regardless the context and no other value ever maps to it (by adding one to a
non-negative expression). We compute modulo three of a five-cells-wide window
which gives us sufficiently “random” blinking pattern and three symbols to shift
through.

With these two reductions, all we need is `grow`

to generate as many
configurations as we like the height of the tree to be and `blink`

to animate
it. The generations produced using `grow`

will act as initial configurations of
the automaton with the transition function `blink`

. We can exploit Haskell’s
laziness to generate a comprehensive tree and worry about its height, width, and
number of animation frames once we want to display it.

```
trees :: [ [ Zipper Int ] ]
= transpose $ iterate (extend blink) <$> tree
trees where
= iterate (extend grow) initConf tree
```

Repeated application of `grow`

through `iterate`

produces tapes to stack and we
use each of those configurations with `blink`

to animate. All `transpose`

gives
is a list of frames of trees instead of a list of lists of configurations.

## Displaying infinity

This is the trivial bit of it. Since the tree is vertically symmetric on the zipper focus, we can take equal number of items on each side to set the width and take as many tapes as we want to set the height.

```
frame :: Int -> Int -> [ Zipper a ] -> [ [ a ] ]
= take height $ frameConfig <$> zs
frame halfWidth height zs where
Zipper ls a rs) =
frameConfig (reverse (take (halfWidth - 1) ls) ++ a : take (halfWidth - 1) rs
```

Asterisks, pluses, and x make better tree ornaments than integers.

```
display :: Int -> Char
0 = ' '
display 1 = 'x'
display 2 = '*'
display 3 = '+' display
```

Bringing all of this together we can print frames *forever* (though `blink`

behaves periodically) with some UNIX trickery to clear the terminal and
inserting delays so our petty human eyes can follow the blinking.

```
= do
main let (halfWidth, height) = (17, 16)
$ \fr -> do
forM_ trees putStrLn (intercalate "\n" (fmap display <$> frame halfWidth height fr))
500000
threadDelay putStr "\ESC[2J" -- UNIX trickery to clear the terminal.
```

## Concluding thoughts

Here it is, another comonad tutorial. I don’t think it is any better than the others, but it produces something different. A good exercise for strengthening your comonad-fu would be coding Conway’s Game of Life with the rules encoded as a reduction and the board represented as a two dimensional array. Perhaps you pursue understanding it categorically; in that case, come and tell me about it.

Happy past, present, and future holidays.

The full program is below for your convenience.

```
{-# LANGUAGE DeriveFunctor #-}
module Main where
import Data.List (transpose, intercalate)
import Control.Concurrent (threadDelay)
import Control.Monad (forM_)
class Functor w => Comonad w where
extract :: w a -> a
duplicate :: w a -> w (w a)
extend :: (w a -> b) -> w a -> w b
= fmap f (duplicate cm)
extend f cm
data Zipper a = Zipper [ a ] a [ a ] deriving Functor
right :: Zipper a -> Zipper a
left,Zipper (l:ls) a rs) = Zipper ls l (a:rs)
left (Zipper ls a (r:rs)) = Zipper (a:ls) r rs
right (
instance Comonad Zipper where
Zipper _ a _) = a
extract (= Zipper (tail $ iterate left u) u (tail $ iterate right u)
duplicate u
= Zipper (repeat 0) 1 (repeat 0)
initConf
grow :: Zipper Int -> Int
Zipper (l:_) a (r:_)) = if l == r then 0 else 1
grow (
blink :: Zipper Int -> Int
Zipper _ 0 _) = 0
blink (Zipper (l1:l2:_) a (r1:r2:_)) = 1 + (l1 + l2 + a + r1 + r2) `mod` 3
blink (
trees :: [ [ Zipper Int ] ]
= transpose $ iterate (extend blink) <$> tree
trees where
= iterate (extend grow) initConf
tree
frame :: Int -> Int -> [ Zipper a ] -> [ [ a ] ]
= take height $ frameConfig <$> zs
frame halfWidth height zs where
Zipper ls a rs) =
frameConfig (reverse (take (halfWidth - 1) ls) ++ a : take (halfWidth - 1) rs
display :: Int -> Char
0 = ' '
display 1 = 'x'
display 2 = '*'
display 3 = '+'
display
= do
main let (halfWidth, height) = (17, 16)
$ \fr -> do
forM_ trees putStrLn (intercalate "\n" (fmap display <$> frame halfWidth height fr))
500000
threadDelay putStr "\ESC[2J" -- UNIX trickery to clear the terminal.
```

In fact, the connection between a list and a zipper goes way deeper. The latter is the differentiation of the former. Try to wrap your head around that! Or don’t and read (parts of) the wonderfully titled paper

*“Clowns to the left of me, jokers to the right”*by Conor McBride.↩︎This is a common pattern. Streams and non-empty lists for example follow pretty much the same implementation for

`duplicate`

. Here are the instances without further explanation.↩︎`instance Comonad Stream where Cons x _) = x extract (@(Cons _ xs) = Cons s (duplicate xs) duplicate s instance Comonad NonEmpty where :| _) = x extract (x @(_ :| xxs) = n :| case of xxs duplicate n-> [] [] :xs -> duplicate (x :| xs) x`

I admit that stacking one dimensional configurations is a bit awkward and perhaps a two dimensional one is more natural. Well, it is less fun that way, but if you insist you can use a two dimensional array to produce a similar tree. Here is an example declaration of such an array from Dominic Orchard’s paper titled

*“A notation for Comonads”*.`data CArray i a = CA (Array i a) i`

You might get a two dimensional array that would help for our purposes with a type such as

`CArray (Int,Int) Int`

.↩︎Fractally inclined reader will realise this is, in fact, how you construct the Sierpeński triangle.↩︎