----------------------------------------
--  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
   delTree,     -- Ord a => a -> STree a -> STree a
   minTree,     -- Ord a => STree a -> a
   printTree     -- Show a => STree a -> IO ()
  )
where
import Test.QuickCheck
import Control.Monad 

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

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

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

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

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

insertList :: Ord a => [a] -> STree a -> STree a
insertList [] t     = t
insertList (v:vs) t = insertList vs (insTree v t)       


b1 = insertList ([99,95..1]++[2,6..100]++[98,94..1]++[4,8..100]) nil
b2 = insertList [2,4..10] nil
b3 = insertList [5,3,2,7,6,4] nil
b4 = insertList ([1,3..6]++[6,4..0]) nil


-- fuer QuickCheck Testgenerierung
instance Arbitrary a => Arbitrary  (STree a)
  where
     arbitrary =  sized stree

stree :: Arbitrary a => Int -> Gen (STree a)
stree 0 = return nil 
stree n |n>0 = frequency [ (1,return nil),
                           (4,liftM3 node arbitrary subT subT)]
            where subT = stree (n `div` 2)