2017-04-26 123 views
1

在以下代码中,如何让cataM自上而下遍历树(而不是像现在这样是自下而上的)?cataM的评估顺序

我想我应该实现foldMap不同,但因为branch如何给孩子之前处理branch节点本身没有t实例,它儿都没有?

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"]) 

回答

1

这听起来像你正在寻找一个同时由俄罗斯套娃提供的功能topDownCataM