{-  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 :: forall av. [av] -> BinSearchTree av
tab2tree [av]
tab = BinSearchTree av
tree
 where
  (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 a
0 [av]
list     = (BinSearchTree av
forall av. BinSearchTree av
Nil   , [av]
list)
  sl2bst a
n [av]
list
   = let
      ll :: a
ll = (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
2 ; rl :: a
rl = a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1 a -> a -> a
forall a. Num a => a -> a -> a
- a
ll
      (BinSearchTree av
lt,av
a:[av]
list1) = a -> [av] -> (BinSearchTree av, [av])
sl2bst a
ll [av]
list
      (BinSearchTree av
rt,  [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 :: forall a b c.
(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 :: forall a b. (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 :: 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 (Node BinSearchTree a
Nil  a
kv BinSearchTree a
Nil)
  =  let comp :: d -> Ordering
comp = b -> d -> Ordering
cmp (a -> b
key a
kv)
         r :: c
r    = a -> c
val a
kv
     in \d
i -> case d -> Ordering
comp d
i of
              Ordering
LT -> Maybe c
forall a. Maybe a
Nothing
              Ordering
EQ -> c -> Maybe c
forall a. a -> Maybe a
Just c
r
              Ordering
GT -> Maybe c
forall a. Maybe a
Nothing

btLookup a -> b
key a -> c
val b -> d -> Ordering
cmp (Node BinSearchTree a
left a
kv BinSearchTree a
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 \d
i -> case d -> Ordering
comp d
i of
              Ordering
LT -> Maybe c
forall a. Maybe a
Nothing
              Ordering
EQ -> c -> Maybe c
forall a. a -> Maybe a
Just c
r
              Ordering
GT -> d -> Maybe c
findleft d
i

btLookup a -> b
key a -> c
val b -> d -> Ordering
cmp (Node BinSearchTree a
Nil a
kv 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 \d
i -> case d -> Ordering
comp d
i of
                  Ordering
LT -> d -> Maybe c
findright d
i
                  Ordering
EQ -> c -> Maybe c
forall a. a -> Maybe a
Just c
r
                  Ordering
GT -> Maybe c
forall a. Maybe a
Nothing

btLookup a -> b
key a -> c
val b -> d -> Ordering
cmp (Node BinSearchTree a
left a
kv 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 \d
i -> case d -> Ordering
comp d
i of
              Ordering
LT -> d -> Maybe c
findright d
i
              Ordering
EQ -> c -> Maybe c
forall a. a -> Maybe a
Just c
r
              Ordering
GT -> d -> Maybe c
findleft d
i

btLookup a -> b
_ a -> c
_ b -> d -> Ordering
_ BinSearchTree a
Nil   =  \d
i -> Maybe c
forall a. Maybe a
Nothing