about the concatenation on a tree

hi all, not sure if there is someone still working during holiday like me : ) I got a little problem in implementing some operations on tree. suppose we have a tree date type defined: data Tree a = Leaf a | Branch (Tree a) (Tree a) I want to do a concatenation on these tree just like the concat on list. Anyone has idea on it? or there are some existing implementation? Thank you and Happy New Year! regards, Max

I'm not working, but still checking mail. If you don't care about balancing the tree or the order of elements, you can just use Branch :: Tree a -> Tree a -> Tree a as a concatenation operator. Check with GHCi to see that the Branch constructor actually has the above type. / Emil Max cs skrev:
hi all, not sure if there is someone still working during holiday like me : )
I got a little problem in implementing some operations on tree.
suppose we have a tree date type defined:
data Tree a = Leaf a | Branch (Tree a) (Tree a)
I want to do a concatenation on these tree just like the concat on list. Anyone has idea on it? or there are some existing implementation?
Thank you and Happy New Year!
regards, Max
------------------------------------------------------------------------
_______________________________________________ Haskell-Cafe mailing list Haskell-Cafe@haskell.org http://www.haskell.org/mailman/listinfo/haskell-cafe

Forgot to send this to the list.
On Wed, 31 Dec 2008 16:05:10 +0100, Max cs
hi all, not sure if there is someone still working during holiday like me : )
I got a little problem in implementing some operations on tree.
suppose we have a tree date type defined:
data Tree a = Leaf a | Branch (Tree a) (Tree a)
I want to do a concatenation on these tree just like the concat on list. Anyone has idea on it? or there are some existing implementation?
Thank you and Happy New Year!
regards, Max
Hi Max, A simple way to do this:
module TreeConcat where
data Tree a = Leaf a | Branch (Tree a) (Tree a) deriving Show
treeConcat :: Tree a -> Tree a -> Tree atreeConcat xs ys = Branch xs ys
main :: IO () main = print $ treeConcat (Leaf 1) (Leaf 2)
But perhaps you want a certain ordering? Have a look at: http://hackage.haskell.org/packages/archive/AvlTree/4.2/doc/html/Data-Tree-A... -- Regards, Henk-Jan van Tuyl -- http://functor.bamikanarie.com http://Van.Tuyl.eu/ --
participants (3)
-
Emil Axelsson
-
Henk-Jan van Tuyl
-
Max cs