Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

What benefits do I get from creating an instance of Comonad

In my application, I'm trying to implement an animation system. In this system, animations are represented as a cyclic list of frames:

data CyclicList a = CL a [a]

We can (inefficiently) advance the animation as follows:

advance :: CyclicList a -> CyclicList a
advance (CL x []) = CL x []
advance (CL x (z:zs)) = CL z (zs ++ [x])

Now, I'm pretty sure that this data type is a comonad:

instance Functor CyclicList where
  fmap f (CL x xs) = CL (f x) (map f xs)

cyclicFromList :: [a] -> CyclicList a
cyclicFromList [] = error "Cyclic list must have one element!"
cyclicFromList (x:xs) = CL x xs

cyclicLength :: CyclicList a -> Int
cyclicLength (CL _ xs) = length xs + 1

listCycles :: CyclicList a -> [CyclicList a]
listCycles cl = let
  helper 0 _ = []
  helper n cl' = cl' : (helper (n-1) $ advance cl')
 in helper (cyclicLength cl) cl

instance Comonad CyclicList where
  extract (CL x _) = x
  duplicate = cyclicFromList . listCycles

The question I have is: what kind of benefits do I get (if any) from using the comonad instance?

like image 796
Mokosha Avatar asked Sep 04 '14 23:09

Mokosha


1 Answers

The advantage of providing a type class or implementing an interface is that code, written to use that typeclass or interface, can use your code without any modifications.

What programs can be written in terms of Comonad? A Comonad provides a way to both inspect the value at the current location (without observing its neighbors) using extract and a way to observe the neighborhood of every location with duplicate or extend. Without any additional functions, this isn't terribly useful. However, if we also require other functions along with the Comonad instance, we can write programs that depend on both local data and data from elsewhere. For example, if we require functions that allow us to change location, such as your advance, we can write programs that depend only on the local structure of the data, not on the data structure itself.

For a concrete example, consider a cellular automata program written in terms of Comonad and the following Bidirectional class:

class Bidirectional c where
    forward  :: c a -> Maybe (c a)
    backward :: c a -> Maybe (c a)

The program could use this, together with Comonad, to extract data stored in a cell and explore the cells forward and backward of the current cell. It can use duplicate to capture the neighborhood of each cell and fmap to inspect that neighborhood. This combination of fmap f . duplicate is extract f.

Here is such a program. rule' is only interesting to the example; it implements cellular automata rules on neighborhood with just the left and right values. rule extracts data from the neighborhood, given the class, and runs the rule on each neighborhood. slice pulls out even larger neighborhoods so that we can display them easily. simulate runs the simulation, displaying these larger neighborhoods for each generation.

rule' :: Word8 -> Bool -> Bool -> Bool -> Bool
rule' x l m r = testBit x ((if l then 4 else 0) .|. (if m then 2 else 0) .|. (if r then 1 else 0))

rule :: (Comonad w, Bidirectional w) => Word8 -> w Bool -> w Bool
rule x = extend go
    where
        go w = rule' x (maybe False extract . backward $ w) (extract w) (maybe False extract . forward $ w)

slice :: (Comonad w, Bidirectional w) => Int -> Int -> a -> w a -> [a]
slice l r a w = sliceL l w (extract w : sliceR r w)
    where
        sliceR r w | r > 0 = case (forward w) of
            Nothing -> take r (repeat a)
            Just w' -> extract w' : sliceR (r-1) w'
        sliceR _ _ = []
        sliceL l w r | l > 0 = case (backward w) of
            Nothing -> take l (repeat a) ++ r
            Just w' -> sliceL (l-1) w' (extract w':r)
        sliceL _ _ r = r

simulate :: (Comonad w, Bidirectional w) => (w Bool -> w Bool) -> Int -> Int -> Int -> w Bool -> IO ()
simulate f l r x w = mapM_ putStrLn . map (map (\x -> if x then '1' else '0') . slice l r False) . take x . iterate f $ w

This program might have been intended to work with the following Bidirectional Comonad, a Zipper on a list.

data Zipper a = Zipper {
    heads :: [a],
    here  :: a,
    tail  :: [a]
} deriving Functor

instance Bidirectional Zipper where
    forward (Zipper _ _ []    ) = Nothing
    forward (Zipper l h (r:rs)) = Just $ Zipper (h:l) r rs
    backward (Zipper []     _ _) = Nothing
    backward (Zipper (l:ls) h r) = Just $ Zipper ls l (h:r)

instance Comonad Zipper where
    extract = here
    duplicate (Zipper l h r) = Zipper (goL (h:r) l) (Zipper l h r) (goR (h:l) r)
        where
            goL r []    = []
            goL r (h:l) = Zipper l h r : goL (h:r) l
            goR l []    = []
            goR l (h:r) = Zipper l h r : goR (h:l) r

But will also work with a CyclicList Bidirectional Comonad.

data CyclicList a = CL a (Seq a)
    deriving (Show, Eq, Functor)

instance Bidirectional CyclicList where
    forward (CL x xs) = Just $ case viewl xs of
        EmptyL    -> CL x xs
        x' :< xs' -> CL x' (xs' |> x)
    backward (CL x xs) = Just $ case viewr xs of
        EmptyR    -> CL x xs
        xs' :> x' -> CL x' (x <| xs')

instance Comonad CyclicList where
    extract   (CL x _) = x
    duplicate (CL x xs) = CL (CL x xs) (go (singleton x) xs)
        where
            go old new = case viewl new of
                EmptyL -> empty
                x' :< xs' -> CL x' (xs' >< old) <| go (old |> x') xs'

We can reuse simulate with either data structure. The CyclicList has a more interesting output, because, instead of bumping into a wall, it wraps back around to interact with itself.

{-# LANGUAGE DeriveFunctor #-}

import Control.Comonad
import Data.Sequence hiding (take)
import Data.Bits
import Data.Word

main = do
    putStrLn "10 + 1 + 10 Zipper"
    simulate (rule 110) 10 10 30 $ Zipper (take 10 . repeat $ False) True (take 10 . repeat $ False)
    putStrLn "10 + 1 + 10 Cyclic"
    simulate (rule 110) 10 10 30 $ CL True (fromList (take 20 . repeat $ False))
like image 97
Cirdec Avatar answered Nov 01 '22 11:11

Cirdec