Histomorphisms, Zygomorphisms and Futumorphisms specialised to lists

Question

I ended up figuring it out. See the video and slides of a talk I gave:

• slides/pdf

• video

Original question:

In my effort to understand generic recursion schemes (i.e., that use Fix) I have found it useful to write list-only versions of the various schemes. It makes it much easier to understand the actual schemes (without the additional overhead of the Fix stuff).

However, I have not yet figured out how to define list-only versions of zygo and futu.

Here are my specialised definitions so far:

cataL :: (a ->        b -> b) -> b -> [a] -> b cataL f b (a : as) = f a    (cataL f b as) cataL _ b []       = b  paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b paraL f b (a : as) = f a as (paraL f b as) paraL _ b []       = b  -- TODO: histo  -- DONE: zygo (see below)  anaL  :: (b ->       (a, b))               -> b -> [a] anaL  f b = let (a, b') = f b in a : anaL f b'  anaL' :: (b -> Maybe (a, b))               -> b -> [a] anaL' f b = case f b of     Just (a, b') -> a : anaL' f b'     Nothing      -> []  apoL :: ([b] -> Maybe (a, Either [b] [a])) -> [b] -> [a] apoL f b = case f b of     Nothing -> []     Just (x, Left c)  -> x : apoL f c     Just (x, Right e) -> x : e  -- DONE: futu (see below)  hyloL  :: (a -> c -> c) -> c -> (b -> Maybe (a, b)) -> b -> c hyloL f z g = cataL f z . anaL' g  hyloL' :: (a -> c -> c) -> c -> (c -> Maybe (a, c))      -> c hyloL' f z g = case g z of     Nothing     -> z     Just (x,z') -> f x (hyloL' f z' g) 

How do you define histo, zygo and futu for lists?

Answer 1

Zygomorphism is the high-falutin' mathsy name we give to folds built from two semi-mutually recursive functions. I'll give an example.

Imagine a function pm :: [Int] -> Int (for plus-minus) which intersperses + and - alternately through a list of numbers, such that pm [v,w,x,y,z] = v - (w + (x - (y + z))). You can write it out using primitive recursion:

lengthEven :: [a] -> Bool lengthEven = even . length  pm0 [] = 0 pm0 (x:xs) = if lengthEven xs              then x - pm0 xs              else x + pm0 xs 

Clearly pm0 is not compositional - you need to inspect the length of the whole list at each position to determine whether you're adding or subtracting. Paramorphism models primitive recursion of this sort, when the folding function needs to traverse the whole subtree at each iteration of the fold. So we can at least rewrite the code to conform to an established pattern.

paraL :: (a -> [a] -> b -> b) -> b -> [a] -> b paraL f z [] = z paraL f z (x:xs) = f x xs (paraL f z xs)  pm1 = paraL (\x xs acc -> if lengthEven xs then x - acc else x + acc) 0 

But this is inefficient. lengthEven traverses the whole list at each iteration of the paramorphism resulting in an O(n²) algorithm.

---

We can make progress by noting that both lengthEven and para can be expressed as a catamorphism with foldr...

cataL = foldr  lengthEven' = cataL (\_ p -> not p) True paraL' f z = snd . cataL (\x (xs, acc) -> (x:xs, f x xs acc)) ([], z) 

... which suggests that we may be able to fuse the two operations into a single pass over the list.

pm2 = snd . cataL (\x (isEven, total) -> (not isEven, if isEven                                                       then x - total                                                       else x + total)) (True, 0) 

We had a fold which depended on the result of another fold, and we were able to fuse them into one traversal of the list. Zygomorphism captures exactly this pattern.

zygoL :: (a -> b -> b) ->  -- a folding function          (a -> b -> c -> c) ->  -- a folding function which depends on the result of the other fold          b -> c ->  -- zeroes for the two folds          [a] -> c zygoL f g z e = snd . cataL (\x (p, q) -> (f x p, g x p q)) (z, e) 

On each iteration of the fold, f sees its answer from the last iteration as in a catamorphism, but g gets to see both functions' answers. g entangles itself with f.

We'll write pm as a zygomorphism by using the first folding function to count whether the list is even or odd in length and the second one to calculate the total.

pm3 = zygoL (\_ p -> not p) (\x isEven total -> if isEven                                                 then x - total                                                 else x + total) True 0 

This is classic functional programming style. We have a higher order function doing the heavy lifting of consuming the list; all we had to do was plug in the logic to aggregate results. The construction evidently terminates (you need only prove termination for foldr), and it's more efficient than the original hand-written version to boot.

Aside: @AlexR points out in the comments that zygomorphism has a big sister called mutumorphism, which captures mutual recursion in all its glory. mutu generalises zygo in that both the folding functions are allowed to inspect the other's result from the previous iteration.

mutuL :: (a -> b -> c -> b) ->          (a -> b -> c -> c) ->          b -> c ->          [a] -> c mutuL f g z e = snd . cataL (\x (p, q) -> (f x p q, g x p q)) (z, e) 

You recover zygo from mutu simply by ignoring the extra argument. zygoL f = mutuL (\x p q -> f x p)

---

Of course, all of these folding patterns generalise from lists to the fixpoint of an arbitrary functor:

newtype Fix f = Fix { unFix :: f (Fix f) }  cata :: Functor f => (f a -> a) -> Fix f -> a cata f = f . fmap (cata f) . unFix  para :: Functor f => (f (Fix f, a) -> a) -> Fix f -> a para f = snd . cata (\x -> (Fix $ fmap fst x, f x))  zygo :: Functor f => (f b -> b) -> (f (b, a) -> a) -> Fix f -> a zygo f g = snd . cata (\x -> (f $ fmap fst x, g x))  mutu :: Functor f => (f (b, a) -> b) -> (f (b, a) -> a) -> Fix f -> a mutu f g = snd . cata (\x -> (f x, g x)) 

Compare the definition of zygo with that of zygoL. Also note that zygo Fix = para, and that the latter three folds can be implemented in terms of cata. In foldology everything is related to everything else.

You can recover the list version from the generalised version.

data ListF a r = Nil_ | Cons_ a r deriving Functor type List a = Fix (ListF a)  zygoL' :: (a -> b -> b) -> (a -> b -> c -> c) -> b -> c -> List a -> c zygoL' f g z e = zygo k l     where k Nil_ = z           k (Cons_ x y) = f x y           l Nil_ = e           l (Cons_ x (y, z)) = g x y z  pm4 = zygoL' (\_ p -> not p) (\x isEven total -> if isEven                                                  then x - total                                                  else x + total) True 0 

Answer 2

Since no one else has answered for futu yet, I'll try to stumble my way through. I'm going to use ListF a b = Base [a] = ConsF a b | NilF

Taking the type in recursion-schemes: futu :: Unfoldable t => (a -> Base t (Free (Base t) a)) -> a -> t.

I'm going to ignore the Unfoldable constraint and substitute [b] in for t.

(a -> Base [b] (Free (Base [b]) a)) -> a -> [b] (a -> ListF b (Free (ListF b) a)) -> a -> [b] 

Free (ListF b) a) is a list, possibly with an a-typed hole at the end. This means that it's isomorphic to ([b], Maybe a). So now we have:

(a -> ListF b ([b], Maybe a)) -> a -> [b] 

Eliminating the last ListF, noticing that ListF a b is isomorphic to Maybe (a, b):

(a -> Maybe (b, ([b], Maybe a))) -> a -> [b] 

Now, I'm pretty sure that playing type-tetris leads to the only sensible implementation:

futuL f x = case f x of   Nothing -> []   Just (y, (ys, mz)) -> y : (ys ++ fz)     where fz = case mz of       Nothing -> []       Just z -> futuL f z 

Summarizing the resulting function, futuL takes a seed value and a function which may produce at least one result, and possibly a new seed value if it produced a result.

At first I thought this was equivalent to

notFutuL :: (a -> ([b], Maybe a)) -> a -> [b] notFutuL f x = case f x of   (ys, mx) -> ys ++ case mx of     Nothing -> []     Just x' -> notFutuL f x' 

And in practice, perhaps it is, more or less, but the one significant difference is that the real futu guarantees productivity (i.e. if f always returns, you will never be stuck waiting forever for the next list element).