----------------------------------------
--  Implementierung von Suchbaeumen   --
----------------------------------------
{- 
Datenstruktur:
-----------------------------------------------
data STree a = Nil | Node a (STree a) (STree a)
-----------------------------------------------
Ein binaerer Baum t = (Node val left right) mit Wurzelwert val, 
linkem Teilbaum left und rechtem Teilbaum right ist ein "Suchbaum", 
wenn folgende Bedingungen gelten:

1.) Alle Werte im linken Teilbaum sind kleiner als der Wurzelwert 
    val.
2.) Alle Werte im rechten Teilbaum sind groesser als der  
    Wurzelwert val.
3.) Die Teilbaeume left und right sind Suchbaeume.

Der leere Baum Nil ist ein Suchbaum. 

-}
module SearchTree 
  (STree, 
   nil,         -- STree a
   node,        -- a -> STree a -> STree a -> STree a
   isNil,       -- STree a -> Bool
   isNode,      -- STree a -> Bool
   leftSub,     -- STree a -> STree a
   rightSub,    -- STree a -> STree a
   rootVal,     -- STree a -> a 
   insTree,     -- Ord a => a -> STree a -> STree a
   delete,      -- Ord a => a -> STree a -> STree a
   minTree,     -- Ord a => STree a -> a
   showTree     -- STree -> IO ()
  )
where

data STree a = Nil | Node a (STree a) (STree a)
                deriving (Show)
-- Konstruktor, Test- und Selektorfunktionen

nil :: STree a
nil =  Nil

node :: a -> STree a -> STree a -> STree a
node v l r = Node v l r

isNil      :: STree a -> Bool
isNil Nil  =  True
isNil _    =  False

isNode     :: STree a -> Bool
isNode Nil =  False
isNode _   =  True

leftSub                :: STree a -> STree a
leftSub Nil            =  error "leftSub"
leftSub (Node _ t1 _)  =  t1

rightSub               :: STree a -> STree a 
rightSub Nil           =  error "rightSub"
rightSub (Node _ _ t2) =  t2

rootVal                :: STree a -> a 
rootVal Nil            =  error "rootVal"
rootVal (Node v _ _)   =  v


-- Einfuegen in den Suchbaum 
-- unter Beibehaltung der Suchbaumeigenschaft

insTree             :: Ord a => a -> STree a -> STree a
insTree v Nil       =  (Node v Nil Nil)
insTree v tree@(Node val left right) 
        | val == v  =  tree
        | v < val   =  (Node val (insTree v left) right)
        | v > val   =  (Node val left (insTree v right))


minTree               :: Ord a => STree a -> a
minTree Nil           =  error "minTree"
minTree (Node val left right) 
        | isNil left  =  val
        | otherwise   =  minTree left

delete                :: Ord a => a -> STree a -> STree a
delete v Nil          =  Nil
delete v (Node val left right) 
        | v < val     =  Node val (delete v left) right
        | v > val     =  Node val left (delete v right)
        | isNil left  =  right
        | isNil right =  left
        | otherwise   =  join left right

-- Hilfsfunktion join wird in delete benoetigt
--
join :: Ord a => STree a -> STree a -> STree a
join t1 t2 = Node miniT2 t1 newT2
  where miniT2 = minTree t2
        newT2  = delete miniT2 t2

-- Bildschirmausgabe von Baeumen
printTree :: Show a => STree a -> [String]
printTree t | isNil t   = ["!"]
            | otherwise 
            = (strRootVal ++ "--" ++ (head (printTree right))):
              (map (('|':blanks)++) (tail (printTree right))) ++  ["|"] ++
              (printTree left)
            where left  = leftSub t
                  right = rightSub t
                  strRootVal = (show (rootVal t))
                  nr = length strRootVal
                  blanks = replicate (nr+1) ' ' 

showTree :: Show a => STree a -> IO ()
showTree = putStr . unlines . printTree