haskellcomonadfixpoint-combinators

Using Comonad Fix Combinators

So I've been experimenting with fixed points lately and have finally struggled through regular fixed points enough to discover some uses; now I'm moving onto comonadic fixed points and I'm afraid I've gotten stuck;

Here's a few examples of what I've tried and what has/hasn't worked:

{-# language DeriveFunctor #-}
{-# language FlexibleInstances #-}
module WFix where

import Control.Comonad
import Control.Comonad.Cofree
import Control.Monad.Fix

So I started with loeb's theorem as a list; each element of the list is a function which takes the end result to compute its answer; this lets me do 'spreadsheet' calculations where values can depend on other values.

spreadSheetFix :: [Int]
spreadSheetFix = fix $ \result -> [length result, (result !! 0) * 10, (result !! 1) + 1, sum (take 3 result)]

Okay, so I have basic fix working, time to move on to the comonad types! Here's a few simple comonads to use for examples:

  data Stream a = S a (Stream a)
    deriving (Eq, Show, Functor)

  next :: Stream a -> Stream a
  next (S _ s) = s

  instance Comonad Stream where
    extract (S a _) = a
    duplicate s@(S _ r) = S s (duplicate r)

  instance ComonadApply Stream where
    (S f fs) <@> (S a as) = S (f a) (fs <@> as)

  data Tape a = Tape [a] a [a]
    deriving (Show, Eq, Functor)

  moveLeft, moveRight :: Tape a -> Tape a
  moveLeft w@(Tape [] _ _) = w
  moveLeft (Tape (l:ls) a rs) = Tape ls l (a:rs)

  moveRight w@(Tape _ _ []) = w
  moveRight (Tape ls a (r:rs)) = Tape (a:ls) r rs

  instance Comonad Tape where
    extract (Tape _ a _) = a
    duplicate w@(Tape l _ r) = Tape lefts w rights
      where
        lefts = zipWith const (tail $ iterate moveLeft w) l
        rights = zipWith const (tail $ iterate moveRight w) r

  instance ComonadApply Tape where
    Tape l f r <@> Tape l' a r' = Tape (zipWith ($) l l') (f a) (zipWith ($) r r')

Okay so the following combinators come from Control.Comonad;

wfix :: Comonad w => w (w a -> a) -> a
wfix w = extract w (extend wfix w)

cfix :: Comonad w => (w a -> a) -> w a
cfix f = fix (extend f)

kfix :: ComonadApply w => w (w a -> a) -> w a
kfix w = fix $ \u -> w <@> duplicate u

I started with trying out wfix:

streamWFix :: Int
streamWFix = wfix st
  where
    incNext = succ . extract . next
    st = (S incNext (S incNext (S (const 0) st)))

> streamWFix
-- 2

This one seems to work by calling the first w a -> a on w until reaching a resolution const 0 in this case; that makes sense. We can also do this with a Tape:

selfReferentialWFix :: Int
selfReferentialWFix = wfix $ Tape [const 10] ((+5) . extract . moveLeft) []
-- selfReferentialWFix == 15

K, I think I get that one, but the next ones I'm kind of stuck, I don't seem to have an intuition for what cfix is supposed to do. Even the simplest possible thing I could think of spins forever when I evaluate it; even trying to extract the first element of the stream using getOne fails.

getOne :: Stream a -> a
getOne (S a _) = a

simpleCFix :: Stream Int
simpleCFix = cfix go
  where
    go _ = 0

Similarly with kfix; even simple tries don't seem to terminate. My understanding of kfix was that the function in each 'slot' gets passed a copy of the evaluated comonad focused on that spot; is that the case?

I tried using 'getOne' on this:

streamKFix :: Stream Int
streamKFix = kfix st
  where
    go _ = 0
    st = S go st

Here's a finite attempt using Tape which also fails to run:

tapeKFix :: Tape Int
tapeKFix = kfix $ Tape [] (const 0) []

So; down to my question, could someone please offer some runnable (non-trivial) examples of using cfix and kfix, and explain how they work? I plan to use kfix to eventually do a "Conway's game of life" style experiment, am I correct in thinking that kfix would be useful in working with neighbourhoods around a given cell?

Feel free to ask any clarifying questions and help me expand my knowledge and intuition of fix!

Thanks!

Solution

  • The ComonadApply and Comonad instances for Tape are insufficiently lazy to be used with kfix.

    duplicate for Tape requires that you prove the tape exists before it can conclude that the result is a Tape

    instance Comonad Tape where
  extract (Tape _ a _) = a
  duplicate w@(Tape l _ r) = Tape lefts w rights
--             ^             ^
-- matches a Tape            |               
-- before determining that the result is a Tape

    <@> checks that both arguments are tapes before it can conclude that the result is a Tape

    instance ComonadApply Tape where
  Tape l f r <@> Tape l' a r' = Tape (zipWith ($) l l') (f a) (zipWith ($) r r')
-- ^             ^              ^
-- matches two Tapes            |
-- before detrmining that the result is a Tape

    Combined there's no way for kfix (Tape _ _ _) to ever produce Tape

    kfix w            = fix $ \u -> w            <@> duplicate u
kfix (Tape _ _ _) = fix $ \u -> (Tape _ _ _) <@> duplicate u
kfix (Tape _ _ _) = fix $ \u -> (Tape _ _ _) <@> case u of (Tape _ _ _) -> ...
--                         ^                                |
--                         ----------- <<loop>> -------------

    You can fix this by making duplicate, <@>, or both more productive by using irrefutable patterns. A pattern ~(Tape l a r) matches even if the Tape constructor hasn't been produced yet. Here's how you'd use it to make duplicate productive

    instance Comonad Tape where
  extract (Tape _ a _) = a
  duplicate w@(~(Tape l _ r)) = Tape lefts w rights
    where
      lefts = zipWith const (tail $ iterate moveLeft w) l
      rights = zipWith const (tail $ iterate moveRight w) r

    Irrefutable pattern matches are equivalent to using functions to extract values. For duplicate it's equivalent to writing

    left  (Tape l _ _) = l
right (Tape _ _ r) = r

instance Comonad Tape where
  extract (Tape _ a _) = a
  duplicate w = Tape lefts w rights
    where
      l = left w
      r = right w
      ...