[Haskell-cafe] about the concatenation on a tree

Henk-Jan van Tuyl hjgtuyl at chello.nl
Wed Dec 31 14:22:17 EST 2008


Forgot to send this to the list.

On Wed, 31 Dec 2008 16:05:10 +0100, Max cs <max.cs.2009 at googlemail.com>
wrote:

> 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-AVL.html#44


-- 
Regards,
Henk-Jan van Tuyl


--
http://functor.bamikanarie.com
http://Van.Tuyl.eu/
--



More information about the Haskell-Cafe mailing list