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