Search code examples
purescriptrecursion-schemescatamorphism

Order of evaluation for cataM


In the following code, how is it possible to have cataM traverse the tree top-down (and not bottom-up as it is the case currently) ?

I guess I should implement foldMap differently but how to process the branch node itself before the children since branch has no instance of t which are not children?

module Catatree where

import Data.Foldable
import Data.Traversable
import Data.Monoid
import Data.Generic
import Prelude
import Control.Monad.Writer
import Control.Monad.Eff (Eff)
import Control.Monad.Eff.Console (CONSOLE, log, logShow)

import Data.Functor.Mu (Mu)
import Matryoshka (class Corecursive, class Recursive, Algebra, AlgebraM, cata, embed, cataM, project)

data TreeF a t = Leaf | Branch a (Array t)

type IntTree = Mu (TreeF Int)

derive instance treeGeneric :: (Generic a, Generic t) => Generic (TreeF a t)
derive instance treeFunctor :: Functor (TreeF a)

instance showTree :: (Generic a, Generic t) => Show (TreeF a t) where
  show = gShow

instance treeTraversable :: Traversable (TreeF a) where
  -- traverse :: forall a b m. Applicative m => (a -> m b) -> t a -> m (t b)
  traverse f Leaf = pure Leaf
  traverse f (Branch a children) = Branch a <$> traverse f children
  sequence f = sequenceDefault f


instance treeFoldable :: Foldable (TreeF a) where
  foldr f = foldrDefault f
  foldl f = foldlDefault f
  -- foldMap :: forall a m. Monoid m => (a -> m) -> f a -> m
  foldMap f Leaf = mempty
  foldMap f (Branch a children) = foldMap f children

evalM :: AlgebraM (Writer (Array String)) (TreeF Int) Int
evalM Leaf = do
  tell $ [ "visiting leaf " ]
  pure 4
evalM (Branch a children) = do
  tell $ [ "visiting branch " <> show a ]
  pure 2

runM :: forall t. Recursive t (TreeF Int) => t -> Writer (Array String) Int
runM = cataM evalM

branch :: forall t. Corecursive t (TreeF Int) => Int -> Array t -> t
branch i children = embed (Branch i children)

exp :: IntTree
exp = branch 3 [(branch 1 []), (branch 2 [])]

main :: forall eff. Eff (console :: CONSOLE | eff) Unit
main = do
  logShow $ runWriter $ runM exp
  -- outputs (Tuple 2 ["visiting branch 1","visiting branch 2","visiting branch 3"])

Solution

  • It sounds like you're looking for the function topDownCataM that is also provided by Matryoshka. 😄