fork download
copy 
  1. type 'a tree = | Node of 'a * int * 'a tree * 'a tree | Leaf
  2.  
  3. let avlInsert x tree =
  4.   let rotate_right (Node (x, _, Node (y, _, yleft, yright), xright)) =
  5.     Node (y, 0, yleft, Node (x, 0, yright, xright))
  6.   in
  7.   let rotate_left (Node (x, _, xleft, Node (y, _, yleft, yright))) =
  8.     Node (y, 0, Node (x, 0, xleft, yleft), yright)
  9.   in
  10.   let rotate_leftright (Node (x, _,
  11.                               Node (z, _, zleft,
  12.                                     Node (y, ybal, yleft, yright)),
  13.                               xright)) =
  14.     Node (y, 0, Node (z, (if ybal > 0 then -1 else 0), zleft, yleft),
  15.                 Node (x, (if ybal < 0 then 1 else 0), yright, xright))
  16.   in
  17.   let rotate_rightleft (Node (x, _, xleft,
  18.                               Node (z, _,
  19.                                     Node (y, ybal, yleft, yright),
  20.                                     zright))) =
  21.     Node (y, 0, Node (x, (if ybal > 0 then -1 else 0), xleft, yleft),
  22.                 Node (z, (if ybal < 0 then 1 else 0), yright, zright))
  23.   in
  24.   let rec avlInsertAux x tree =
  25.       match tree with
  26.       | Leaf -> (Node (x, 0, Leaf, Leaf), 1)
  27.       | Node (y, bal, left, right) ->
  28.         if x < y then
  29.           let (left_bal, delta_height) = avlInsertAux x left
  30.           in
  31.             if delta_height = 0 then
  32.               (Node (y, bal, left_bal, right), 0)
  33.             else
  34.               let new_bal = bal - delta_height
  35.               in
  36.                 match new_bal with
  37.                 | 0 -> (Node (y, new_bal, left_bal, right), 0)
  38.                 | -1 -> (Node (y, new_bal, left_bal, right), 1)
  39.                 | _ ->
  40.                   let Node (_, bal_l, _, _) = left_bal
  41.                   in
  42.                     if bal_l > 0 then
  43.                       (rotate_leftright (Node (y, new_bal, left_bal, right)), 0)
  44.                     else
  45.                       (rotate_right (Node (y, new_bal, left_bal, right)), 0)
  46.         else
  47.           let (right_bal, delta_height) = avlInsertAux x right
  48.           in
  49.             if delta_height = 0 then
  50.               (Node (y, bal, left, right_bal), 0)
  51.             else
  52.               let new_bal = bal + delta_height
  53.               in
  54.                 match new_bal with
  55.                 | 0 -> (Node (y, new_bal, left, right_bal), 0)
  56.                 | 1 -> (Node (y, new_bal, left, right_bal), 1)
  57.                 | _ ->
  58.                   let Node (_, bal_r, _, _) = right_bal
  59.                   in
  60.                     if bal_r < 0 then
  61.                       (rotate_rightleft (Node (y, new_bal, left, right_bal)), 0)
  62.                     else
  63.                       (rotate_left (Node (y, new_bal, left, right_bal)), 0)
  64.   in
  65.     fst (avlInsertAux x tree)
  66.  
  67. let printTree tree =
  68.   let rec printTreeAux tree level =
  69.     match tree with
  70.     | Leaf -> ()
  71.     | Node (x, bal, left, right) ->
  72.       printTreeAux right (level + 1);
  73.       print_string (String.make level '\t');
  74.       print_int x;
  75.       print_string "|";
  76.       print_int bal;
  77.       print_newline ();
  78.       printTreeAux left (level + 1)
  79.   in
  80.     printTreeAux tree 0
  81.  
  82. let () =
  83.   Leaf
  84.   |> avlInsert 10 |> avlInsert 20 |> avlInsert 30 |> avlInsert 40
  85.   |> avlInsert 27 |> avlInsert 26 |> avlInsert 25 |> avlInsert 28
  86.   |> avlInsert 33 |> avlInsert 34 |> avlInsert 35 |> avlInsert 31
  87.   |> avlInsert 32 |> printTree
Success #stdin #stdout 0s 15896KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
		40|-1
			35|0
	34|-1
				33|0
			32|0
				31|0
		30|1
			28|0
27|1
		26|-1
			25|0
	20|1
		10|0
https://ideone.com/UFrbTK
language:
OCaml (ocamlopt 4.05.0)
created:
7 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!