[Haskell-cafe] How to get all the paths of a tree

[Rene de Visser]

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