{-  Copyright:  S. Doaitse Swierstra
               Department of Computer Science
               Utrecht University
               P.O. Box 80.089
               3508 TB UTRECHT
               the Netherlands
               swierstra@cs.uu.nl
-}
module UU.Util.BinaryTrees

( BinSearchTree(..)
, tab2tree
, btFind
, btLocateIn
, btLookup
)
where
-- =======================================================================================
-- ===== BINARY SEARCH TREES =============================================================
-- =======================================================================================

data BinSearchTree av
 = Node (BinSearchTree av) av (BinSearchTree av)
 | Nil

tab2tree :: [av] -> BinSearchTree av
tab2tree tab = tree
 where
  (tree,[]) = sl2bst (length tab) (tab)
  sl2bst 0 list     = (Nil   , list)
  sl2bst n list
   = let
      ll = (n - 1) `div` 2 ; rl = n - 1 - ll
      (lt,a:list1) = sl2bst ll list
      (rt,  list2) = sl2bst rl list1
     in (Node lt a rt, list2)

-- remember we compare the key value with the lookup value

btFind     :: (a -> b -> Ordering) -> BinSearchTree (a, c) -> b -> Maybe c
btFind     = btLookup fst snd

btLocateIn :: (a -> b -> Ordering) -> BinSearchTree a      -> b -> Maybe a
btLocateIn = btLookup id id

btLookup :: (a -> b) -> (a -> c) -> (b -> d -> Ordering) -> BinSearchTree a -> d -> Maybe c
btLookup  key val cmp (Node Nil  kv Nil)
  =  let comp = cmp (key kv)
         r    = val kv
     in \i -> case comp i of
              LT -> Nothing
              EQ -> Just r
              GT -> Nothing

btLookup key val cmp (Node left kv Nil)
  =  let comp = cmp (key kv)
         findleft = btLookup key val cmp left
         r    = val kv
     in \i -> case comp i of
              LT -> Nothing
              EQ -> Just r
              GT -> findleft i

btLookup key val cmp (Node Nil kv right )
  =  let comp      = cmp (key kv)
         findright = btLookup key val cmp right
         r         = val kv
         in \i -> case comp i of
                  LT -> findright i
                  EQ -> Just r
                  GT -> Nothing

btLookup key val cmp (Node left kv right)
  =  let comp = cmp (key kv)
         findleft  = btLookup key val cmp left
         findright = btLookup key val cmp right
         r    = val kv
     in \i -> case comp i of
              LT -> findright i
              EQ -> Just r
              GT -> findleft i

btLookup _ _ _ Nil   =  \i -> Nothing