



> {-# OPTIONS -fno-monomorphism-restriction #-}

> {-# LANGUAGE MultiParamTypeClasses,FlexibleInstances,Arrows #-}



> import Data.Array

> import Data.Foldable as F

> import Control.Monad

> import Control.Arrow



> data Pointer i e = P { index::i, array::Array i e } deriving Show



> bind f x = x >>= f



> class Functor w => Comonad w where

> (=>>) :: w a -> (w a -> b) -> w b

> x =>> f = fmap f (cojoin x)

> coreturn :: w a -> a

> cojoin :: w a -> w (w a)

> cojoin x = x =>> id

> cobind :: (w a -> b) -> w a -> w b

> cobind f x = x =>> f



> instance Ix i => Functor (Pointer i) where

> fmap f (P i a) = P i (fmap f a)



> instance Ix i => Comonad (Pointer i) where

> coreturn (P i a) = a!i

> P i a =>> f = P i $ listArray bds (fmap (f . flip P a) (range bds))

> where bds = bounds a





m

a -> m b

m a ->m b

w

w a -> b

w a -> w b





> wrap i = if i<0 then i+5 else if i>4 then i-5 else i



> blur (P i a) = do

> let k = wrap (i-1)

> let j = wrap (i+1)

> let s = 1.0*a!k + 2.0*a!i + 1.0*a!j

> print $ "sum = " ++ show s

> return s





w a -> m b

g :: w a -> m b

f :: w b -> m c

bind

cobind

bind g :: w a -> w (m b)

cobind f :: m (w b) -> m c

w (m b)

m (w b)

sequence

[]





> class Distributes m w where

> distribute :: w (m a) -> m (w a)



> instance (Monad m,Ix i) => Distributes m (Pointer i) where

> distribute (P i ma) = do

> let bds = bounds ma

> a <- sequence (elems ma)

> return $ P i (listArray bds a)





a

b

a

b





> data A m w a b = A { runA :: w a -> m b }



> instance (Distributes m w,Monad m,Comonad w) => Arrow (A m w) where

> A g >>> A f = A $ bind f . distribute . cobind g

> first (A f) = A $ \x -> do

> u <- f (fmap fst x)

> return $ (u,coreturn (fmap snd x))

> pure f = A $ return . f . coreturn









> x = P 0 $ listArray (0,4) (map return [0.0..4.0])









> g = proc a -> do

> b <- A blur -< a

> n <- A blur -< 1

> returnA -< a-b/n





x





> liftCM :: (Distributes m w, Monad m, Comonad w) => A m w a b -> w (m a) -> w (m b)

> liftCM (A f) = cobind (\x -> distribute x >>= f)



> y = liftCM g x









> result = sequence (toList (Main.array y))





liftCM

A m w a b

w (m a) -> w (m b)

m (w a) -> m (w b)

I can't yet read most of this paper on Combining a Monad and a Comonad because I've no experience with 2-categories. Nonetheless, there's something useful I can extract from the bits that do make sense - the idea of combining a monad with a comonad in the way that we already combine monads using monad transformers. In my previous post I hinted at the idea that the cobind operation for a comonad was a bit like an operation on a SIMD computer that allows every processor to get access to information local to every other processor. The idea now will be to allow those processors to also exploit monads to perform operations like IO.First let me first reintroduce the code for the array comonads I considered before so that this post again becomes a self-contained literate Haskell post:Remember how things work with monads. Ifis a monad, then given a functionwe can lift it to a function. Similarly, with a comonadwe can lift a functionto a function. In fact, I wrote about all this a while back Just like before, we can write a simple 'blur' function, except this time it also performs some I/O.Notice that blur is of the form. So how can we compose these things?Considerand. Usingandwe can 'lift' the head and tail of these functions:andWe can almost compose these functions. But the catch is that we need a function fromto. Conveniently, there's a prototypical example of such a thing in the ghc libraries, the functionwhich distributes any monad over. As we can easily move back and forth between arrays and lists we can write:And now we can compose these funny dual-sided Kleisli/coKleisli arrows. But before writing a composition function, note what we have. We're looking at functions that can make-ish things to-ish things, and we can compose them like functions directly fromto. This is precisely the design pattern captured by arrows. So we can write:Now check out page 1323 of Signals and Comonads by Uustalu and Vene. Honestly, I found that paper after I wrote the above code. It's almost line for line identical!Anyway, now we can try an example. First some data to work on:This is like last post's except that as I've now used a non-normalised blur operation I can show how arrow notation makes it easy to fix that:That's a very simple (and inefficient) high pass filter by the way. At the end of the day, however, we still need to be able to lift our arrows to act onAnd convert the result to something we can look at:It might not be quite the result you expected because we see a lot of I/O. Each computation that is tainted with I/O will carry that I/O with it. So every bit of I/O that was computed by any value that that went into the final result remains hanging round its neck until the bitter end, with duplications if the value was duplicated.Of course there are lots of other monad/comonad pairs to try, so maybe there are some other interesting combinations lurking around.Exercise:lifts an arrowto a function. You can also implement a lift to. Implement it and figure out what it does.