-------------------------------------------------------------------------
--  
--         Tree.hs
--  
--     Search trees as an ADT                   
--                                  
--         (c) Addison-Wesley, 1996-2011.                   
--  
-------------------------------------------------------------------------
                                                            
module Tree 
  (Tree,
   nil,           -- Tree a
   isNil,         -- Tree a -> Bool  
   isNode,        -- Tree a -> Bool
   leftSub,       -- Tree a -> Tree a 
   rightSub,      -- Tree a -> Tree a 
   treeVal,       -- Tree a -> a
   insTree,       -- Ord a => a -> Tree a -> Tree a 
   delete,        -- Ord a => a -> Tree a -> Tree a
   minTree,        -- Ord a => Tree a -> Maybe a
   elemT           -- Ord a => a -> Tree a -> Bool
  ) where


data Tree a = Nil | Node a (Tree a) (Tree a)                    
--  

nil :: Tree a

nil :: forall a. Tree a
nil = Tree a
forall a. Tree a
Nil

isNil :: Tree a -> Bool
isNil :: forall a. Tree a -> Bool
isNil Tree a
Nil = Bool
True
isNil Tree a
_   = Bool
False

isNode :: Tree a -> Bool
isNode :: forall a. Tree a -> Bool
isNode Tree a
Nil = Bool
False 
isNode Tree a
_   = Bool
True

leftSub, rightSub :: Tree a -> Tree a

leftSub :: forall a. Tree a -> Tree a
leftSub Tree a
Nil            = [Char] -> Tree a
forall a. HasCallStack => [Char] -> a
error [Char]
"leftSub"
leftSub (Node a
_ Tree a
t1 Tree a
_) = Tree a
t1

rightSub :: forall a. Tree a -> Tree a
rightSub Tree a
Nil            = [Char] -> Tree a
forall a. HasCallStack => [Char] -> a
error [Char]
"rightSub"
rightSub (Node a
v Tree a
t1 Tree a
t2) = Tree a
t2

treeVal  :: Tree a -> a

treeVal :: forall a. Tree a -> a
treeVal Tree a
Nil            = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"treeVal"
treeVal (Node a
v Tree a
_ Tree a
_) = a
v

insTree :: Ord a => a -> Tree a -> Tree a

insTree :: forall a. Ord a => a -> Tree a -> Tree a
insTree a
val Tree a
Nil = (a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
val Tree a
forall a. Tree a
Nil Tree a
forall a. Tree a
Nil)

insTree a
val (Node a
v Tree a
t1 Tree a
t2)
  | a
va -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
val  = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
v Tree a
t1 Tree a
t2
  | a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
v     = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
v Tree a
t1 (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
insTree a
val Tree a
t2)    
  | a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v     = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
v (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
insTree a
val Tree a
t1) Tree a
t2    

delete :: Ord a => a -> Tree a -> Tree a

delete :: forall a. Ord a => a -> Tree a -> Tree a
delete a
val (Node a
v Tree a
t1 Tree a
t2)
  | a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
v     = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
v (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
delete a
val Tree a
t1) Tree a
t2
  | a
val a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
v     = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
v Tree a
t1 (a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
delete a
val Tree a
t2)
  | Tree a -> Bool
forall a. Tree a -> Bool
isNil Tree a
t2    = Tree a
t1
  | Tree a -> Bool
forall a. Tree a -> Bool
isNil Tree a
t1    = Tree a
t2
  | Bool
otherwise   = Tree a -> Tree a -> Tree a
forall a. Ord a => Tree a -> Tree a -> Tree a
join Tree a
t1 Tree a
t2


minTree :: Ord a => Tree a -> Maybe a

minTree :: forall a. Ord a => Tree a -> Maybe a
minTree Tree a
t
  | Tree a -> Bool
forall a. Tree a -> Bool
isNil Tree a
t     = Maybe a
forall a. Maybe a
Nothing
  | Tree a -> Bool
forall a. Tree a -> Bool
isNil Tree a
t1    = a -> Maybe a
forall a. a -> Maybe a
Just a
v
  | Bool
otherwise   = Tree a -> Maybe a
forall a. Ord a => Tree a -> Maybe a
minTree Tree a
t1
      where
      t1 :: Tree a
t1 = Tree a -> Tree a
forall a. Tree a -> Tree a
leftSub Tree a
t
      v :: a
v  = Tree a -> a
forall a. Tree a -> a
treeVal Tree a
t

elemT :: Ord a => a -> Tree a -> Bool

elemT :: forall a. Ord a => a -> Tree a -> Bool
elemT a
x Tree a
Nil       = Bool
False
elemT a
x (Node a
y Tree a
t1 Tree a
t2)
  | a
xa -> a -> Bool
forall a. Ord a => a -> a -> Bool
<a
y          = a -> Tree a -> Bool
forall a. Ord a => a -> Tree a -> Bool
elemT a
x Tree a
t1
  | a
xa -> a -> Bool
forall a. Eq a => a -> a -> Bool
==a
y         = Bool
True
  | Bool
otherwise    = a -> Tree a -> Bool
forall a. Ord a => a -> Tree a -> Bool
elemT a
x Tree a
t2



-- The join function is an auxiliary, used in delete, where note that it
-- joins two trees with the property that all elements in the left are
-- smaller than all in the right; that will be the case for the call in
-- delete. 

-- join is not exported.

join :: Ord a => Tree a -> Tree a -> Tree a

join :: forall a. Ord a => Tree a -> Tree a -> Tree a
join Tree a
t1 Tree a
t2 
  = a -> Tree a -> Tree a -> Tree a
forall a. a -> Tree a -> Tree a -> Tree a
Node a
mini Tree a
t1 Tree a
newt
    where
    (Just a
mini) = Tree a -> Maybe a
forall a. Ord a => Tree a -> Maybe a
minTree Tree a
t2
    newt :: Tree a
newt        = a -> Tree a -> Tree a
forall a. Ord a => a -> Tree a -> Tree a
delete a
mini Tree a
t2