In haskell, the Fix f
data type allows you to specify a recursive datatype from its fixpoint. Folds and unfolds, as catamorphisms and anamorphisms, come for free. With these recursion schemes, functions can be specified over the data type without explicit recursion. A catamorphism folds bottom-top to a single value, while its dual the anamorphism can be used to unfold a single value.
newtype Fix f = Fix { unFix :: f (Fix f) }
cata :: Functor f => (f a -> a) -> Fix f -> a
cata alg = alg . fmap (cata alg) . unFix
ana :: Functor f => (a -> f a) -> a -> Fix f
ana coalg = Fix . fmap (ana coalg) . coalg
Example
A binary tree is a recursive data type that lends itself perfectly well for definition by Fix
. Notice that TreeF
is not recursive and would also allow for example for a tagged binary tree by using a CoFree a f
Comonad.
{-# LANGUAGE TypeSynonymInstances,FlexibleInstances,LambdaCase,DeriveFunctor #-}
type Tree a = Fix (TreeF a)
data TreeF a r = NodeF r r | LeafF a deriving Functor
instance Show a => Show (Tree a) where
show = cata $ \case
NodeF l r -> unwords ["(", l, r, ")"]
LeafF x -> show x
*Main> let node l r = Fix $ NodeF l r
*Main> let leaf x = Fix $ LeafF x
*Main> (leaf 0 `node` leaf 1) `node` (leaf 2 `node` leaf 3)
( ( 0 1 ) ( 2 3 ) )
Adding Context
However, the catamorphism only passes information bottom to top. It is not possible to pass down context from a parent node to a child node. I came across this problem when converting an expression to its DeBruijn convention form. A simpler use case that can not be done solely using a catamorphism is tagging the leaves of a tree with their depth.
ctxm
:: Functor f
=> t -> (f (Fix f) -> t -> t)
-> (t -> f b -> b) -> Fix f -> b
ctxm ctx nxt alg (Fix f) = alg ctx (fmap (ctxm (nxt f ctx) nxt alg) f)
I believe it is certainly possible to archieve this using existing recursion schemes (there are a lot of them), but trying to do that took me longer than finding this function. Here is an example of depth-tagging the above-defined binary tree.
label :: Tree a -> Tree (Integer, a)
label = ctxm 0 nxt alg where
-- state/context modifying function
nxt (NodeF _ _) = (+1)
nxt (LeafF _) = id
-- algorithm that uses the context
alg ctx (LeafF x) = Fix $ LeafF (ctx, x)
alg ctx (NodeF l r) = Fix $ NodeF l r
*Main> label $ (leaf 0 `node` leaf 1) `node` leaf 3
( ( (2,0) (2,1) ) (1,3) )
And there it is, a catamorphism with context.