Cellular Automata Using Komonad

One evening I stumbled upon an article on the implementation of a one-dimensional cellular automaton using comonads, but the material is incomplete and a little outdated, and therefore decided to write a Russian-language adaptation (at the same time considering two-dimensional cellular automata using the example of Game of Life):

Universe

Consider a data type Universedefined as follows:

data Universe a = Universe [a] a [a]

This is an endless list on both sides, but with a focus on an element that we can shift using functions:

left, right :: Universe a -> Universe a
left  (Universe (a:as) x bs) = Universe as a (x:bs)
right (Universe as x (b:bs)) = Universe (x:as) b bs

In essence, this is a zipper type , but we can consider this as a constant C-pointer to an infinite memory area: increment and decrement operations are applicable to it. But how to dereference it? To do this, we define a function that takes out a focused value:

extract :: Universe a -> a
extract (Universe _ x _) = x

For example, it Universe [-1, -2..] 0 [1, 2..]is all integers. However, Universe [0, -1..] 1 [2, 3..]these are the same integers, but with a slightly changed context (we point to another element).



If we want to get all degrees 2, then we need a way to apply the function (2**)to Universeintegers. It’s easy enough to define an instance of the Functor class that obeys all laws:

instance Functor Universe where
    fmap f (Universe as x bs) = Universe (fmap f as) (f x) (fmap f bs)
-- соответственно
powersOf2 = fmap (2**) (Universe [-1, -2..] 0 [1, 2..])
-- ..0.25, 0.5, 1, 2, 4..

In a cellular automaton, the values ​​of the cells depend on the values ​​of all the other cells in the previous step. Therefore, we can create Universeall the shifts and the rule of convolution:

duplicate :: Universe a -> Universe (Universe a)
duplicate u = Universe (tail $ iterate left u) u (tail $ iterate right u)

A convolution rule must have a type Universe a -> a, so an Universe Boolexample of a rule might be:

rule :: Universe Bool -> Bool
rule u = lx /= cx
    where lx  = extract $ left  u
          cx  = extract u

Applying the rule to the Universe of all shifts, we get the following state of the automaton:

next :: Universe a -> (Universe a -> a) -> Universe a
next u r = fmap r (duplicate u)
-- соответственно
un = Universe (repeat False) True (repeat False) `next` rule

Comonads

We may notice that our functions obey the following laws:

extract . duplicate      = id
fmap extract . duplicate = id
duplicate . duplicate    = fmap duplicate . duplicate

Therefore, it Universeforms a comonad , and the function nextcorresponds to the operator (=>>). The Komonada is a dual of the monad, in connection with which one can trace some analogies between their operations. For example, joincombines nested contexts, but duplicate, on the contrary, doubles the context; returnputs into context, and extract- extracts from it, etc.

Two-dimensional cellular automaton

Now, we can just as well implement a two-dimensional cellular automaton. First, declare a two-dimensional type Universe:

newtype Universe2 a = Universe2 { getUniverse2 :: Universe (Universe a) }

In Haskell, it’s very easy to apply a function to nested containers using composition fmap, so writing a class instance Functorfor Universe2no problem:

instance Functor Universe2 where
    fmap f = Universe2 . (fmap . fmap) f . getUniverse2

Komonad instances are done in the same way as the regular Universe, and since Universe2 is just a wrapper, we can define methods in terms of existing ones. For example, extractsimply executing it twice is enough. In duplicate, however, we must get shifts of nested contexts, for which an auxiliary function is defined

instance Comonad Universe2 where
    extract = extract . extract . getUniverse2
    duplicate = fmap Universe2 . Universe2 . shifted . shifted . getUniverse2
        where shifted :: Universe (Universe a) -> Universe (Universe (Universe a))
              shifted u = Universe (tail $ iterate (fmap left) u) u (tail $ iterate (fmap right) u)

That is almost all! It remains only to determine the rule and apply it with (=>>). In Game of Life, the new state of the cell depends on the state of neighboring cells, so we define the function of their location:

nearest3 :: Universe a -> [a]
nearest3 u = fmap extract [left u, u, right u]
neighbours :: (Universe2 a) -> [a]
neighbours u =
    [ nearest3 . extract . left
    , pure     . extract . left  . extract
    , pure     . extract . right . extract
    , nearest3 . extract . right
    ] >>= ($ getUniverse2 u)

And here is the rule itself:

data Cell = Dead | Alive
    deriving (Eq, Show)
rule :: Universe2 Cell -> Cell
rule u
    | nc == 2   = extract u
    | nc == 3   = Alive
    | otherwise = Dead
    where nc = length $ filter (==Alive) (neighbours u)

There remains only a boring conclusion, which I will not consider separately.

Conclusion

Thus, we can implement any cellular automaton, just by defining a function rule. We get an infinite field as a gift, thanks to lazy calculations, although this creates a problem such as linear memory consumption.
The fact is that since we apply the rule to each element of an infinite list, to calculate cells that have not yet been accessed, it will be necessary to go through all the previous steps, which means they must be stored in memory.

Source codes of both files:



Thanks to int_index for helping with this article.