Histomorphisms, Zygomorphisms and Futumorphisms specialised to lists
Histomorphism models dynamic programming, the technique of tabulating the results of previous subcomputations. (It's sometimes called course-of-value induction.) In a histomorphism, the folding function has access to a table of the results of earlier iterations of the fold. Compare this with the catamorphism, where the folding function can only see the result of the last iteration. The histomorphism has the benefit of hindsight - you can see all of history.
Here's the idea. As we consume the input list, the folding algebra will output a sequence of b
s. histo
will jot down each b
as it emerges, attaching it to the table of results. The number of items in the history is equal to the number of list layers you've processed - by the time you've torn down the whole list, the history of your operation will have a length equal to that of the list.
This is what the history of iterating a list(ory) looks like:
data History a b = Ancient b | Age a b (History a b)
History
is a list of pairs of things and results, with an extra result at the end corresponding to the []
-thing. We'll pair up each layer of the input list with its corresponding result.
cataL = foldr
history :: (a -> History a b -> b) -> b -> [a] -> History a b
history f z = cataL (\x h -> Age x (f x h) h) (Ancient z)
Once you've folded up the whole list from right to left, your final result will be at the top of the stack.
headH :: History a b -> b
headH (Ancient x) = x
headH (Age _ x _) = x
histoL :: (a -> History a b -> b) -> b -> [a] -> b
histoL f z = headH . history f z
(It happens that History a
is a comonad, but headH
(née extract
) is all we need to define histoL
.)
History
labels each layer of the input list with its corresponding result. The cofree comonad captures the pattern of labelling each layer of an arbitrary structure.
data Cofree f a = Cofree { headC :: a, tailC :: f (Cofree f a) }
(I came up with History
by plugging ListF
into Cofree
and simplifying.)
Compare this with the free monad,
data Free f a = Free (f (Free f a))
| Return a
Free
is a coproduct type; Cofree
is a product type. Free
layers up a lasagne of f
s, with values a
at the bottom of the lasagne. Cofree
layers up the lasagne with values a
at each layer. Free monads are generalised externally-labelled trees; cofree comonads are generalised internally-labelled trees.
With Cofree
in hand, we can generalise from lists to the fixpoint of an arbitrary functor,
newtype Fix f = Fix { unFix :: f (Fix f) }
cata :: Functor f => (f b -> b) -> Fix f -> b
cata f = f . fmap (cata f) . unFix
histo :: Functor f => (f (Cofree f b) -> b) -> Fix f -> b
histo f = headC . cata (\x -> Cofree (f x) x)
and once more recover the list version.
data ListF a r = Nil_ | Cons_ a r deriving Functor
type List a = Fix (ListF a)
type History' a b = Cofree (ListF a) b
histoL' :: (a -> History' a b -> b) -> b -> List a -> b
histoL' f z = histo g
where g Nil_ = z
g (Cons_ x h) = f x h
Aside:
histo
is the dual offutu
. Look at their types.histo :: Functor f => (f (Cofree f a) -> a) -> (Fix f -> a) futu :: Functor f => (a -> f (Free f a)) -> (a -> Fix f)
futu
ishisto
with the arrows flipped and withFree
replaced byCofree
. Histomorphisms see the past; futumorphisms predict the future. And much likecata f . ana g
can be fused into a hylomorphism,histo f . futu g
can be fused into a chronomorphism.
Even if you skip the mathsy parts, this paper by Hinze and Wu features a good, example-driven tutorial on histomorphisms and their usage.
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(n2) 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
generaliseszygo
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
frommutu
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 fixed point 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