Commits

Paweł Wieczorek committed 86e2e67 Draft

working on rebalancer

Comments (0)

Files changed (1)

     | Node (_, _, node_depth, _) ->
         node_depth := !node_depth + diff
 
+let clone_ref r = ref !r
+
 let rec clone r = ref (clone_node !r)
 and clone_node = function
     | Empty ->
     | Node(left_avl, right_avl, node_depth, a) ->
         Node(clone left_avl, clone right_avl, ref !node_depth, a)
 
+
 (*********************************************************************************************************************
  * Creators
  ********************************************************************************************************************)
 
  *)
 
+let rotate_right avl =
+    match !avl with
+        | Empty ->
+            ()
+
+        | Node (left_avl, right_avl, node_depth, a) ->
+            begin match !left_avl with
+                | Empty ->
+                    ()
+
+                | Node (sub_left_avl, sub_right_avl, sub_node_depth, sub_a) ->
+                    let a_avl = clone_ref sub_left_avl in
+                    let b_avl = clone_ref sub_right_avl in
+                    let c_avl = clone_ref right_avl in
+
+                    right_avl     := !left_avl;
+                    left_avl      := !a_avl;
+                    sub_left_avl  := !b_avl;
+                    sub_right_avl := !c_avl
+
+            end
+
+
+let rotate_left avl =
+    match !avl with
+        | Empty ->
+            ()
+
+        | Node (left_avl, right_avl, node_depth, a) ->
+            begin match !right_avl with
+                | Empty ->
+                    ()
+
+                | Node (sub_left_avl, sub_right_avl, sub_node_depth, sub_a) ->
+                    let a_avl = clone_ref left_avl in
+                    let b_avl = clone_ref sub_left_avl in
+                    let c_avl = clone_ref sub_right_avl in
+
+                    left_avl      := !right_avl;
+                    right_avl     := !c_avl;
+                    sub_left_avl  := !a_avl;
+                    sub_right_avl := !b_avl
+
+            end
 
 (*********************************************************************************************************************
  * Balance
     | Node (left_avl, right_avl, node_depth, a) ->
         depth left_avl - depth right_avl
 
-let single_rebalance_node = function
+let balance_rr avl =
+    rotate_left avl
+
+let balance_rl avl = 
+    match !avl with
+        | Empty ->
+            ()
+
+        | Node (left_avl, right_avl, node_depth, a) ->
+            rotate_right right_avl;
+            rotate_left avl
+
+let balance_ll avl =
+    rotate_right avl
+
+let balance_lr avl = 
+    match !avl with
+        | Empty ->
+            ()
+
+        | Node (left_avl, right_avl, node_depth, a) ->
+            rotate_left left_avl;
+            rotate_right avl
+
+let single_rebalance avl = match !avl with
     | Empty ->
         ()
 
         match balance_factor_node node with
         | n when n < -1 ->
             if balance_factor right_avl < 1 then
-                (* right_right_case *)
-                ()
+                balance_rr avl
             else
                 (* right_left_case *)
                 ()
 
 let no_rebalance_node _ = ()
 
-let rec rebalance r = rebalance_node !r
-and rebalance_node = function
+let rec rebalance avl = match !avl with
     | Empty ->
         ()
 
     | Node (left_avl, right_avl, _, _) as node ->
         rebalance left_avl;
         rebalance right_avl;
-        single_rebalance_node node
+        single_rebalance avl
         
 
 (*********************************************************************************************************************
  * Remove
  ********************************************************************************************************************)
 
-let rec raw_remove balance_strategy pred avl =
-    avl := raw_remove_node balance_strategy pred !avl
+let rec raw_remove balance_strategy stop_after_first a avl =
+    avl := raw_remove_node balance_strategy stop_after_first a !avl
 
-and raw_remove_node balance_strategy a = function
+and raw_remove_node balance_strategy stop_after_first a = function
     | Empty ->
         Empty
 
     | Node (left_avl, right_avl, node_depth, b) as node ->
         begin match compare a b with
             | n when n < 0 ->
-                raw_remove balance_strategy a left_avl;
+                raw_remove balance_strategy stop_after_first a left_avl;
                 node
 
             | n when n > 0 ->
-                raw_remove balance_strategy a right_avl;
+                raw_remove balance_strategy stop_after_first a right_avl;
                 node
 
             | _ ->
+                if not stop_after_first then begin
+                    raw_remove balance_strategy stop_after_first a left_avl;
+                    raw_remove balance_strategy stop_after_first a right_avl
+                end;
                 node
         end