    {-  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 a. [a] -> 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