bind

return

Num





> data Zipper a = Zipper [a] [a] deriving (Eq,Show)



> left (Zipper (a:as) bs) = Zipper as (a:bs)

> right (Zipper as (b:bs)) = Zipper (b:as) bs



> class Comonad w where

> coreturn :: w a -> a

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



> iterate1 f x = tail $ iterate f x



> instance Comonad Zipper where

> cobind f a = fmap f $ Zipper (iterate1 left a) (iterate right a)

> coreturn (Zipper _ (b:_)) = b



> a = Zipper (repeat 0) ([0,1,2,3]++repeat 0)

> f (Zipper (a:_) (b:c:_)) = a+2*b+c



> test = let Zipper u v = cobind f a in take 5 v





test

f

cobind

f

Zipper a -> a

a

Zipper a

bind



0 -> 0 0 0 0 0 0

1 -> 0 1 2 1 0 0

2 -> 0 0 2 4 2 0

3 -> 0 0 0 3 6 3

0 -> 0 0 0 0 0 0

----------------

0 1 4 8 8 3



bind

bind'

return'





> plus (Zipper a b) (Zipper a' b') = Zipper (plus' a a') (plus' b b') where

> plus' (a:as) (b:bs) = (a+b) : plus' as bs

> plus' a [] = a

> plus' [] a = a





left

right





> left' (Zipper (a:as) bs) = Zipper as (a:bs)

> left' (Zipper [] bs) = Zipper [] (0:bs)

> right' (Zipper as (b:bs)) = Zipper (b:as) bs

> right' (Zipper as []) = Zipper (0:as) []



> tail' [] = []

> tail' a = tail a

> stagger f [] = []

> stagger f (x:xs) = x : map f (stagger f xs)

> stagger1 f x = tail' (stagger f x)



> instance Functor Zipper where

> fmap f (Zipper a b) = Zipper (map f a) (map f b)









> return' a = Zipper [] [a]

> bind' f x = let Zipper a b = fmap f x

> in foldl1 plus (stagger left' b ++ stagger1 right' a)



> a' = Zipper [] [0,1,2,3]

> f' x = Zipper [x] [2*x,x]



> test' = let Zipper u v = bind' f' a' in take 5 v





test'

Labels: haskell, mathematics