[Haskell-cafe] How to get all the paths of a tree
Rene de Visser
rene_de_visser at hotmail.com
Mon Sep 19 06:52:47 EDT 2005
module MyTree where
import Data.Tree
import Data.Generics
-- define my tree type
data MyTree = MyTree (Tree Integer) deriving Show
data YourTree = YourTree (Tree String) deriving Show
-- create the test data structure
test1 = MyTree (Node 1 [Node 2 [], Node 3 []])
-- Transform my tree into a tree of strings using show.
transform :: MyTree -> Tree String
transform (MyTree node) = fmap (show) node
trans :: (Show a, Functor f) => f a -> f String
trans tree = fmap (show) tree
-- The ordering of the operations here, gives the different folds...
-- Need to have a look at the paper.
-- The first parameter is the tree node, the second parameter is the list
-- of return values, where each item is the result from the subtree,
--
-- This function can effectively only be used bottom up, because the only
input
-- parameter to func comes from the call "(map (treeFold func))", i.e. the
rest of
-- the tree. We can only tell when are are at a leaf ( [b] is empty ).
-- Add in the other tree fold here!
treeFold :: (a -> [b] -> b) -> Tree a -> b
treeFold func (Node header list) = func header (map (treeFold func) list)
myToYours payload children = (Node (show payload) children)
myToYours2 :: (Num a) => a -> Forest a -> Tree a
myToYours2 payload children = (Node (payload + (childSum children))
children)
where childSum :: (Num b) => Forest b -> b
childSum children = foldr (+) 0 $ map rootLabel children
test4 (MyTree tree) = treeFold myToYours2 tree
test5 = test4 test1
test2 = transform test1
-- display my tree
test3 = putStr $ drawTree test2
-- add 1 to each node
add1 (Node x y) = Node (1 + x) y
--test4 :: MyTree
--test4 = everywhere add1 test1
tree_seed = [4,5,6]
-- unfold receives the seed and returns the current node and the seeds for
the children?
-- unfoldTree :: (b -> (a, [b])) -> b -> Tree a
tree_construct :: Tree Integer
tree_construct = unfoldTree func (100,tree_seed,0)
where func (value, seed, depth) | depth < 100 = (value, map expand seed)
| otherwise = (value, [])
where expand value = (value + depth, seed, depth + 1)
test6 = putStr $ drawTree $ trans $ tree_construct
newtype Seq1 = Seq1 [Integer] deriving Show
append_path :: Integer -> Seq1 -> Seq1
append_path value (Seq1 path) = Seq1 $ value:path
tree_path :: Integer -> [Seq1_List] -> Seq1_List
tree_path child [] = [Seq1 [child]] -- Good, returns a seq1 list.
tree_path child accum = map (\path :: Seq1 -> append_path child path)
(concat accum)
type Seq1_List = [Seq1]
tree_paths :: Seq1_List
tree_paths = treeFold tree_path tree_construct
test7 = take 2 $ tree_paths
More information about the Haskell-Cafe
mailing list