BEGIN 16_10_06_BinaryTree.lhs

> module BinaryTree where

If we want to put (Tree a) in the type classes Eq, Ord and Show, 
we can write: 

   data Tree a =   Leaf a  |  Node (Tree a) (Tree a)
                   deriving (Eq,Ord,Show)

NOTE: This definition of "Tree a" is different from that of "Tree a" in
the handout 16_10_04_GeneralizedFold.lhs and also different from "Tree a" 
in Assignment #3.

The interpreted hugs and ghci will try their best to derive how "==" and "<" 
should work on trees. These will be the implicit default definitions of "=="
and "<" on trees.

The default "==" corresponds to equality between trees, naturally enough.
How about the default "<"? It is a little more complicated. We wish to 
choose the following ordering on trees, which contradicts the default
ordering chosen by hugs or ghci:

   if "t1 = Leaf m" and "t2 = Leaf n" 
   then "t1 < t2" returns True iff m < n

   if "t1 = Leaf m" and "t2 = Node t3 t4" 
   then "t1 < t2" returns True

   if "t1 = Node t3 t4" and "t2 = Leaf m"
   then "t1 < t2" returns False

   if "t1 = Node t3 t4" and "t2 = Node t5 t6"
   then "t1 < t2" returns True iff 
   ("t3 < t5" returns True) OR ("t3 == t5" and "t4 < t6" returns True)

More intuitively, we look for the first address x where t1 and t2 disagree
in a preorder traversal. If x is a leaf in both t1 and t2, we compare the
labels at x in both t1 and t2. If x is a leaf only in t1, then "t1 < t2"
is True.  If x is a leaf only in t2, then "t1 < t2" is False. 

To implement the ordering on trees that we desire, we can explicitly make 
(Tree a) an instance of Eq, Ord and Show, with the advantage that we may 
customize the definitions so that they are different from the default.

>  data Tree a =   Leaf a  |  Node (Tree a) (Tree a)
>  --                deriving (Eq,Ord,Show) -- we do not want the default ordering,
>                                           -- so we have to comment out this line.

Explicitly making (Tree a) an instance of Eq: 

>  
>  instance (Eq a) => Eq (Tree a) where
>     Leaf m  ==  Leaf n       = m==n
>     Node u v  ==  Node x y   = u==x && v==y
>     _  ==  _                 = False 
>  

Explicitly making (Tree a) an instance of Ord: 

>  
>  instance (Ord a) => Ord (Tree a) where
>     Leaf m   <= Leaf n     = m<=n
>     Leaf _   <= Node _ _   = True
>     Node _ _ <= Leaf _     = False
>     Node u v <= Node x y   = u < x || u == x && v <= y
>  

Explicitly making (Tree a) an instance of Show: 

>  
>  instance (Show a) => Show (Tree a) where
>    showsPrec d (Leaf m) = showParen (d >= 10) showStr
>       where
>       showStr = showString "<" . 
>                 (showsPrec 10 m) . 
>                 showString ">"
>    showsPrec d (Node u v) = showParen (d > 4) showStr
>       where
>       showStr = showsPrec 5 u .
>                 showString " [$] " .
>                 showsPrec 5 v 
>  

>  tt0, tt1, tt2, tt3 :: Tree Int
>  tt0  = Leaf 3
>  tt1  = Leaf 4
>  tt2  = Leaf 2
>  tt3  = Leaf 1
>  tt4  = Node tt0 tt1
>  tt5  = Node tt2 tt3
>  tt6  = Node tt4 tt5
>  tt7  = Node tt5 tt4
>  tt8  = Node tt7 tt7

END 16_10_06_BinaryTree.lhs