"Recursive sata structures: Catamorphism with context"

16 feb 2019

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.