Catamorphisms are Post Order, Anamorphisms are Pre Order

The title says it all.

``````> {-# LANGUAGE
>     DeriveFunctor,
>     DeriveFoldable,
>     DeriveTraversable,
>     RankNTypes,
>     FlexibleContexts,
>     NoMonomorphismRestriction,
>     UndecidableInstances,
>     ScopedTypeVariables #-}
>
> import Prelude hiding (mapM)
> import Data.Foldable
> import Data.Traversable
> import Data.Monoid
> import qualified Data.Map as Map
>
> data Term = Plus Term Term
>           | Mult Term Term
>           | IntConst Int
>           deriving Show
>
> data TermF a = PlusF a a
>              | MultF a a
>              | IntConstF Int
>              deriving (Show, Ord, Eq, Functor, Foldable, Traversable)
>
> newtype Mu f = In {out :: f (Mu f)}
>
> instance Eq  (f (Mu f)) => Eq  (Mu f) where
>   In x == In y = x == y
> instance Ord (f (Mu f)) => Ord (Mu f) where
>   In x `compare` In y = x `compare` y
>
> type Term' = Mu TermF
>
> type Algebra f a = f a -> a
> type CoAlgebra f a = a -> f a
>
> cata :: Functor f => Algebra f a -> (Mu f -> a)
> cata f (In x) = f (fmap (cata f) x)
>
> ana :: Functor f => CoAlgebra f a -> (a -> Mu f)
> ana f = In . fmap (ana f) . f
>
> conv :: Term -> Term'
> conv = ana coAlg
>   where
>     coAlg (Plus x y)   = PlusF x y
>     coAlg (Mult x y)   = MultF x y
>     coAlg (IntConst x) = IntConstF x
>
> type MonadicAlgebra f m a = f a -> m a
> type MonadicCoAlgebra f m a = a -> m (f a)
>
> cataM :: (Traversable f, Monad m) =>
>          MonadicAlgebra f m a -> (Mu f -> m a)
> cataM f = f <=< mapM (cataM f) . out
>
> anaM :: (Traversable f, Monad m) =>
>         MonadicCoAlgebra f m a -> a -> m (Mu f)
> anaM f = f >=> liftM In . mapM (anaM f)
>
> cataLabelM :: Mu TermF -> Writer [String] (Mu TermF)
> cataLabelM = cataM alg
>
> alg :: TermF (Mu TermF) -> Writer [String] (Mu TermF)
> alg (PlusF x y)   = tell ["+"]    >> (return \$ In \$ PlusF x y)
> alg (MultF x y)   = tell ["*"]    >> (return \$ In \$ MultF x y)
> alg (IntConstF x) = tell [show x] >>  (return \$ In \$ IntConstF x)
>
> anaLabelM :: Mu TermF -> Writer [String] (Mu TermF)
> anaLabelM = anaM coAlg
>
> coAlg :: Mu TermF -> Writer [String] (TermF (Mu TermF))
> coAlg (In (PlusF x y))   = tell ["+"]    >> (return \$ PlusF x y)
> coAlg (In (MultF x y))   = tell ["*"]    >> (return \$ MultF x y)
> coAlg (In (IntConstF x)) = tell [show x] >> (return \$ IntConstF x)
>
> t0 = let x = (Mult (IntConst 2) (IntConst 3))
>          y = (Mult (IntConst 5) (IntConst 7))
>      in Plus x y
``````

And now we can see examples:

``````*Main> execWriter \$ cataLabelM \$ conv t0
["2","3","*","5","7","*","+"]
*Main> execWriter \$ anaLabelM \$ conv t0
["+","*","2","3","*","5","7"]
``````

But if we have a term with shared sub-expressions then we are just doing the same work many times. As discussed previously we can use caching to circumvent this.

``````> type CacheT a b = StateT (Map.Map a b)
>
> memoise :: (Monad m, Ord a) =>
>            ((a -> CacheT a b m b) -> (a -> CacheT a b m b)) ->
>            (a -> CacheT a b m b)
> memoise f x = gets (Map.lookup x) >>= (`maybe` return)
>   (do y <- f (memoise f) x; modify (Map.insert x y); return y)
>
> cataMemoM :: (Traversable f, Monad m, Ord (Mu f)) =>
>              MonadicAlgebra f m a -> (Mu f -> m a)
> cataMemoM f = (`evalStateT` Map.empty)
>   . memoise (\cataM_f -> lift . f <=< mapM cataM_f . out)
>
> anaMemoM :: (Traversable f, Ord a, Monad m) =>
>      MonadicCoAlgebra f m a -> a -> m (Mu f)
> anaMemoM f = (`evalStateT` Map.empty)
>   . memoise (\anaM_f -> lift . f >=> liftM In . mapM anaM_f)
>
> cataLabelMM :: Mu TermF -> Writer [String] (Mu TermF)
> cataLabelMM = cataMemoM alg
>
> anaLabelMM :: Mu TermF -> Writer [String] (Mu TermF)
> anaLabelMM = anaMemoM coAlg
>
> t1 = let x = Mult (IntConst 2) (IntConst 3)
>      in Plus x x
``````

Now nodes still get visited in pre-order using an anamorphism and post-order using a catamorphism but repeated nodes only get visited once.

``````*Main> execWriter \$ cataLabelMM \$ conv t1
["2","3","*","+"]
*Main> execWriter \$ anaLabelMM \$ conv t1
["+","*","2","3"]
``````