Previous Contents Next

Module Rbtrees

red-black trees. Those are modelled like the ones in CLR90.


exception Not_Found

exception Illegal_Rotation

not visible for the outside
exception Will_Not_Happen

type color = Red | Black

type entry = int

type key = int

type (abrbtree = (* 'a: key, b': elem *)
     Leaf of color 
   | Node of (a,brbtree × (a ×b × color) × (a,brbtree

let toggle x = 
   match x with 
     (k,eBlack® (k,eRed)
   | (k,eRed® (k,eBlack)

let rotate_r tr (bbool) =
   match tr with
     Leaf c ® raise Illegal_Rotation
   | Node (Leaf ___® raise Illegal_Rotation
   | Node (Node (tr_1,c_y,tr_2), c_xtr_3® 
       if b
       then Node(tr_1toggle c_yNode(tr_2toggle c_xtr_3))
       else Node(tr_1c_yNode(tr_2c_xtr_3))

let rotate_l tr (b:bool) =
   match tr with 
     Leaf c ® raise Illegal_Rotation 
   | Node (_,_,Leaf c® raise Illegal_Rotation
   | Node (tr_1c_xNode(tr_2,c_y,tr_3)) ®
       if b 
       then Node(Node(tr_1toggle c_xtr_2), toggle c_ytr_3)
       else Node(Node(tr_1c_xtr_2), c_ytr_3)

let finish tr =
   match tr with
   | Node(Node(t1_l, (k_1e_1Red), t1_r), 
           (k_2,e_2,Red), 
           t3)
     ®
       Node(Node(t1_l, (k_1e_1Red), t1_r),
             (k_2,e_2,Black), 
             t3)
   | Node(t1, (k_2e_2Red), Node(t3_l, (k_3e_3,Red), t3_r)) (* 5' *)
     ®
       Node(t1, (k_2e_2Black), Node(t3_l, (k_3e_3,Red), t3_r))
   | _ ® tr

let rec insert' tr (keyelem) = (* Insert always at the leaves *)
   match tr with
     Leaf c ® 
       Node (Leaf Black, (keyelemRed), Leaf Black
   | Node(tr_l, (key'elem',c'), tr_r®
       if key < key'
       then 
         (let tr'Node(insert' tr_l (keyelem), (key'elem'c'), tr_r)
           in 
           match tr' with 
             Node (Node(t2_l, (* 1 *)
                       (key_2elem_2Red), 
                       Node(t1_l,(key_1,elem_1,Red),t1_r)), 
                   (key_3,elem_3,Black), 
                   Node(t4_l,(key_4,elem_4,Red),t4_r))
             ®
               Node (Node(t2_l
                         (key_2elem_2Black), 
                         Node(t1_l,(key_1,elem_1,Red),t1_r)), 
                     (key_3,elem_3Red), 
                     Node(t4_l,(key_4,elem_4,Black),t4_r))
           | Node (Node(Node(t1_l,(key_1,elem_1,Red),t1_r), (* 2 *)
                       (key_2elem_2Red), 
                       t2_r), 
                   (key_3,elem_3,Black), 
                   Node(t4_l,(key_4,elem_4,Red),t4_r))
             ®
               Node (Node(Node(t1_l,(key_1,elem_1,Red),t1_r), 
                         (key_2elem_2Black), 
                         t2_r), 
                     (key_3,elem_3Red), 
                     Node(t4_l,(key_4,elem_4,Black),t4_r))
           | Node (Node(t2_l, (* 3 *)
                       (key_2elem_2Red), 
                       Node(t1_l,(key_1,elem_1,Red),t1_r)), 
                   (key_3,elem_3,Black), 
                   t4) (* t4 is black (matching): leaf or node *)
             ®
               Node (rotate_l(Node(t2_l
                                   (key_2elem_2Red), 
                                   Node(t1_l,(key_1,elem_1,Red),t1_r))) false
                     (key_3,elem_3Black), 
                     t4)
           | Node (Node(Node(t1_l,(key_1,elem_1,Red),t1_r), (* 4 *)
                       (key_2elem_2Red), 
                       t2_r), 
                   (key_3,elem_3,Black), 
                   t4) (* t4 must be black *)
             ®
               rotate_r
                 (NodeNodeNode(t1_l,(key_1,elem_1,Red),t2_r), 
                             (key_2elem_2Red), 
                             t2_r), 
                       (key_3,elem_3Black), 
                       t4))
                 true 
                   (* we recolor! *)
           | _ ® tr'

                 )
       else (* key >=key' *)
         (let tr'Node(tr_l, (key'elem'c'), insert' tr_r (keyelem))
         in 
         match tr' with
           Node(Node(t4_l,(k4,e4,Red), t4_r), (* 1' *)
                 (k3,e3,Black),
                 Node(Node(t1_l,(k1,e1,Red),t1_r),
                     (k2,e2,Red),
                     t2_r))
             ®
               Node(Node(t4_l,(k4,e4,Black), t4_r),
                     (k3,e3,Red),
                     Node(Node(t1_l,(k1,e1,Red),t1_r),
                         (k2,e2,Black),
                         t2_r))
         | Node(Node(t4_l,(k4,e4,Red), t4_r), (* 2' *)
                 (k3,e3,Black),
                 Node(t2_l,
                     (k2,e2,Red),
                     Node(t1_l,(k1,e1,Red),t1_r)))
           ® 
             Node(Node(t4_l,(k4,e4,Black), t4_r),
                   (k3,e3,Red),
                   Node(t2_l,
                       (k2,e2,Black),
                       Node(t1_l,(k1,e1,Red),t1_r)))

         | Node(t4, (* 3' *)
                 (k3,e3,Black),
                 Node(Node(t1_l,(k1,e1,Red),t1_r),
                     (k2,e2,Red),
                     t2_r))
           ® 
             Node(t4
                   (k3,e3,Black),
                   rotate_r
                     (Node(Node(t1_l,(k1,e1,Red),t1_r),
                           (k2,e2,Red),
                           t2_r))
                     false

                     )
         | Node(t4, (* 4' *)
                 (k3,e3,Black),
                 Node(t2_l,
                       (k2,e2,Red),
                       Node(t1_l,(k1,e1,Red),t1_r)))
           ® 
             rotate_l
               (Node(t4
                     (k3,e3,Black),
                     Node(t2_l,
                           (k2,e2,Red),
                           Node(t1_l,(k1,e1,Red),t1_r))))
               true
         | _ ® tr'

               )

let insert tr (keyelem) =
   finish (insert' tr (keyelem))

let rec search tr key =
   match tr with 
     Leaf c ® raise Not_Found
   | Node(tr_l, (key'elem'c), tr_r®
       if (key = key'then elem'
       else 
         if key < key' 
         then search tr_l key
         else if key' > key 
         then search tr_r key
         else elem' (* <= ist eine totale Ordnung *)

Delete deletes the first fitting node and gives back the the node-info, too
let rec delete' tr key = 
     match tr with
       Leaf _ ® raise Not_Found
     | Node(Leaf _, (k,e,c), Leaf _® (* A leaf can safely be erased *)
         if key = k 
         then (Leaf Black, (k,e,c))
         else raise Not_Found
     | Node(tr_l, (k,e,c), tr_r® raise Will_Not_Happen

let delete tr key = tr
January 31, 2002
Previous Contents Next