Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- cata f = c where c = f . fmap c . project
- {- c = cata f -}
- = f . fmap (cata f) . project
- prepro e f = c where c = f . fmap (c . cata (embed . e)) . project
- {- c = prepro e f -}
- = f . fmap (prepro e f . cata (embed . e)) . project
- #!/usr/bin/env stack
- -- stack --resolver lts-9.14 script
- {-# LANGUAGE TypeFamilies, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
- import Data.Functor.Foldable -- package recursion-schemes
- import Data.Tree -- package containers
- -- Tree a = Rose trees of a
- -- The TH recursion-schemes has breaks down on it, so...
- data TreeF a r = NodeF { rootLabelF :: a, subForestF :: [r] }
- deriving (Functor, Foldable, Traversable)
- type instance Base (Tree a) = TreeF a
- instance Recursive (Tree a) where project (Node a ts) = NodeF a ts
- instance Corecursive (Tree a) where embed (NodeF a ts) = Node a ts
- tree :: Tree Integer
- tree = Node 2 [Node 1 [Node 3 []], Node 7 [Node 1 [], Node 5 []]]
- main = do -- Original
- drawTree' tree
- -- 0th layer: *1
- -- 1st layer: *2
- -- 2nd layer: *4
- -- ...
- drawTree' $ prepro ((NodeF x y) -> NodeF (x*2) y) embed tree
- -- Same thing but a different algebra
- -- "sum with deeper values weighted more"
- print $ prepro ((NodeF x y) -> NodeF (x*2) y) ((+) <$> sum <*> rootLabelF) tree
- where drawTree' = putStr . drawTree . fmap show
Add Comment
Please, Sign In to add comment