{-  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 :: [av] -> BinSearchTree av
tab2tree tab :: [av]
tab = BinSearchTree av
tree
 where
  (tree :: BinSearchTree av
tree,[]) = Int -> [av] -> (BinSearchTree av, [av])
forall a av. Integral a => a -> [av] -> (BinSearchTree av, [av])
sl2bst ([av] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [av]
tab) ([av]
tab)
  sl2bst :: a -> [av] -> (BinSearchTree av, [av])
sl2bst 0 list :: [av]
list     = (BinSearchTree av
forall av. BinSearchTree av
Nil   , [av]
list)
  sl2bst n :: a
n list :: [av]
list
   = let
      ll :: a
ll = (a
n a -> a -> a
forall a. Num a => a -> a -> a
- 1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` 2 ; rl :: a
rl = a
n a -> a -> a
forall a. Num a => a -> a -> a
- 1 a -> a -> a
forall a. Num a => a -> a -> a
- a
ll
      (lt :: BinSearchTree av
lt,a :: av
a:list1 :: [av]
list1) = a -> [av] -> (BinSearchTree av, [av])
sl2bst a
ll [av]
list
      (rt :: BinSearchTree av
rt,  list2 :: [av]
list2) = a -> [av] -> (BinSearchTree av, [av])
sl2bst a
rl [av]
list1
     in (BinSearchTree av -> av -> BinSearchTree av -> BinSearchTree av
forall av.
BinSearchTree av -> av -> BinSearchTree av -> BinSearchTree av
Node BinSearchTree av
lt av
a BinSearchTree av
rt, [av]
list2)

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

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

btLocateIn :: (a -> b -> Ordering) -> BinSearchTree a      -> b -> Maybe a
btLocateIn :: (a -> b -> Ordering) -> BinSearchTree a -> b -> Maybe a
btLocateIn = (a -> a)
-> (a -> a)
-> (a -> b -> Ordering)
-> BinSearchTree a
-> b
-> Maybe a
forall a b c d.
(a -> b)
-> (a -> c)
-> (b -> d -> Ordering)
-> BinSearchTree a
-> d
-> Maybe c
btLookup a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id

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

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

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

btLookup key :: a -> b
key val :: a -> c
val cmp :: b -> d -> Ordering
cmp (Node left :: BinSearchTree a
left kv :: a
kv right :: BinSearchTree a
right)
  =  let comp :: d -> Ordering
comp = b -> d -> Ordering
cmp (a -> b
key a
kv)
         findleft :: d -> Maybe c
findleft  = (a -> b)
-> (a -> c)
-> (b -> d -> Ordering)
-> BinSearchTree a
-> d
-> Maybe c
forall a b c d.
(a -> b)
-> (a -> c)
-> (b -> d -> Ordering)
-> BinSearchTree a
-> d
-> Maybe c
btLookup a -> b
key a -> c
val b -> d -> Ordering
cmp BinSearchTree a
left
         findright :: d -> Maybe c
findright = (a -> b)
-> (a -> c)
-> (b -> d -> Ordering)
-> BinSearchTree a
-> d
-> Maybe c
forall a b c d.
(a -> b)
-> (a -> c)
-> (b -> d -> Ordering)
-> BinSearchTree a
-> d
-> Maybe c
btLookup a -> b
key a -> c
val b -> d -> Ordering
cmp BinSearchTree a
right
         r :: c
r    = a -> c
val a
kv
     in \i :: d
i -> case d -> Ordering
comp d
i of
              LT -> d -> Maybe c
findright d
i
              EQ -> c -> Maybe c
forall a. a -> Maybe a
Just c
r
              GT -> d -> Maybe c
findleft d
i

btLookup _ _ _ Nil   =  \i :: d
i -> Maybe c
forall a. Maybe a
Nothing