(* ---------------------------- Toolbox arbres binaires équilibrés : AVL ---------------------- *)
(*ocamlmktop -custom -o myocaml graphics.cma -cclib -lgraphics -cclib -lX11*)

(*include "FIFO";;*)
# use "FIFO.ml";;
open Graphics;;

(* ---- Définition du type avl ---- *)

type avl = Empty | Node of node
	and node = {mutable delta : int ; mutable key : int ; mutable colour : color ;
	 mutable left_son : avl ; mutable right_son : avl};;
	 
	 
(* ---- Constructeurs et destructeurs ---- *)

let empty_avl() = Empty;;
(*empty_avl : unit -> avl = <fun>*)

let is_empty tree = match tree with
	Empty -> true
	| _ -> false ;;
(*is_empty : avl -> bool = <fun>*)

let make_avl d k c l r =
	Node{delta =d ; key = k ; colour = c ; left_son = l ; right_son = r};;
(*make_avl : int -> int -> color -> avl -> avl -> avl = <fun>*)

let get_node tree = match tree with
	Empty -> failwith "get_node : Empty avl"
	| Node n -> n;;
(*get_node : avl -> node = <fun>*)

let get_key tree = match tree with
	Empty -> failwith "get_key : Empty avl"
	| Node{key = k} -> k;;
(*get_key : avl -> int = <fun>*)

let get_colour tree = match tree with
	Empty -> failwith "get_colour : Empty avl"
	| Node{colour = c} -> c;;
(*get_colour : avl -> color = <fun>*)
	
let get_left tree = match tree with
	Empty -> failwith "get_left : Empty avl"
	| Node{left_son = l} -> l;;
(*get_left : avl -> avl = <fun>*)
	
let get_right tree = match tree with
	Empty -> failwith "get_right : Empty avl"
	| Node{right_son = r} -> r;;
(*get_right : avl -> avl = <fun>*)

let get_delta tree = match tree with
	Empty -> failwith "get_delta : Empty avl"
	| Node{delta = d} -> d;;
(*get_delta : avl -> int = <fun>*)

let rec height tree =
	if is_empty tree then (-1)
	else 1+ (max (height (get_left tree)) (height (get_right tree)));;
(*height : avl -> int = <fun>*)


(* ---- Rotations ---- *)

let avl_right_rotation q =
	if (is_empty q) then failwith "avl_right_rotation : Empty avl"
	else
		let p = get_left q in
		let np = get_node p and nq = get_node q in 
		begin
			if (is_empty p) then failwith "avl_right_rotation : Empty left son";
			nq.left_son <- np.right_son;
			np.right_son <- q;
			p
		end;;
(*avl_right_rotation : avl -> avl = <fun>*)

let avl_left_rotation p =
	if (is_empty p) then failwith "avl_left_rotation : Empty avl"
	else
		let q = get_right p in
		let np = get_node p and nq = get_node q in 
		begin
			if (is_empty q) then failwith "avl_left_rotation : Empty right son";
			np.right_son <- nq.left_son;
			nq.left_son <- p;
			q
		end;;
(*avl_left_rotation : avl -> avl = <fun>*)

let avl_left_right_rotation q =
	if (is_empty q) then failwith "avl_left_right_rotation : Empty avl"
	else
		let r = get_left q in
		let nr = get_node r and nq = get_node q in
		if (is_empty r) then failwith "avl_left_right_rotation : Empty left son"
		else let s=get_right r in let ns=get_node s in
		begin
			if (is_empty s) then failwith "avl_left_right_rotation : Empty left-right son";
			nr.right_son<-ns.left_son;
			nq.left_son <- ns.right_son;
			ns.left_son <- r;
			ns.right_son <- q;
			s
		end;;
(*avl_left_right_rotation : avl -> avl = <fun>*)

let avl_right_left_rotation q =
	if (is_empty q) then failwith "avl_right_left_rotation : Empty avl"
	else
		let r = get_right q in
		let nr = get_node r and nq = get_node q in
		if (is_empty r) then failwith "avl_right_left_rotation : Empty right son"
		else let s=get_left r in let ns=get_node s in
		begin
			if (is_empty s) then failwith "avl_right_left_rotation : Empty right-left son";
			nq.right_son<-ns.left_son;
			nr.left_son <- ns.right_son;
			ns.left_son <- q;
			ns.right_son <- r;
			s
		end;;
(*avl_right_left_rotation : avl -> avl = <fun>*)


(* ---- insertion d'une clef dans un avl ---- *)

let rec tag  t c =
  if not(is_empty t) 
  then  let n=get_node t in
    begin 
      n.colour<-c; 
      tag  n.left_son c; 
      tag  n.right_son c 
    end;;
(*tag : avl -> color -> unit = <fun>*)

let avl_insertion k t=
	let rec insert2 ke tr=
		begin
		  if (is_empty tr) then ( make_avl 0 ke cyan (empty_avl ()) (empty_avl ()) , true)
		    else let key_tr=get_key tr in
		    if (k=key_tr) then (tr, false)
		       else if (k<key_tr) then let (t1,b1)=insert2 ke (get_left tr) in
		         if b1 then (* la hauteur gauche a augmenté*)
		            begin
		              if ((get_delta tr)<=0) then
		              	begin
		              	  (get_node tr).delta<-(get_delta tr)+1;
		              	  (get_node tr).left_son<-t1;
		              	  (tr,((get_delta tr)=1)) (*si le nv déséquilibre est 1, la hauteur a augmenté*)
		              	end
		              else
		                begin
		                if ((get_delta t1)=1) then
		                  begin (* faire une rotation droite sur tr*)
		                    let result=avl_right_rotation tr in
		                      begin
		                		tag result red;
		                        (get_node result).delta<-0;
		                        (get_node (get_node result).right_son).delta<-0;
		                        (result,false)
		                      end
		                  end
		                else
		                  begin(* faire une rotation gauche-droite sur tr*)
		                    let result=avl_left_right_rotation tr in
		                      begin
		                        tag result red;
		                        if ((get_delta result)=1) then
		                           begin
		                             (get_node (get_left result)).delta <- 0; (*il etait à -1*)
		                             (get_node (get_right result)).delta <- (-1) (*il etait à 1*)
		                           end
		                           else if ((get_delta result)= (-1)) then
		                           begin 
		                             (get_node (get_left result)).delta <- 1; (*il etait à -1*)
		                             (get_node (get_right result)).delta <- 0 (*il etait à 1*)
		                           end
		                           else  (* 3eme cas oublié ds le Gaudel *)
		                           begin
		                             (get_node (get_left result)).delta <- 0; 
		                             (get_node (get_right result)).delta <- 0 
		                           end;
		                        (get_node result).delta<-0;
		                        (result,false)
		                      end
		                  end
		                end
		            end
		         else
		            begin
		              (get_node tr).left_son<- t1;
		              (tr,false)
		            end
		       else let (t1,b1)=insert2 ke (get_right tr) in
		         if b1 then (* la hauteur droite a augmenté*)
		            begin
		              if ((get_delta tr)>=0) then
		              	begin
		              	  (get_node tr).delta<-(get_delta tr)-1;
		              	  (get_node tr).right_son<-t1;
		              	  (tr,((get_delta tr)= -1)) (*si le nv déséquilibre est -1, la hauteur a augmenté*)
		              	end
		              else
		                begin
		                if ((get_delta t1)= (-1)) then
		                  begin (* faire une rotation gauche sur tr*)
		                    let result=avl_left_rotation tr in
		                      begin
		                        tag result red;
		                        (get_node result).delta<-0;
		                        (get_node (get_node result).left_son).delta<-0;
		                        (result,false)
		                      end
		                  end
		                else
		                  begin(* faire une rotation droite-gauche sur tr*)
		                    let result=avl_right_left_rotation tr in
		                      begin
		                        tag result red;
		                        if ((get_delta result)=1) then
		                           begin
		                             (get_node (get_left result)).delta <- 0; (*il etait à -1*)
		                             (get_node (get_right result)).delta <- (-1) (*il etait à 1*)
		                           end
		                           else if ((get_delta result)=(-1)) then
		                           begin 
		                             (get_node (get_left result)).delta <- 1; (*il etait à -1*)
		                             (get_node (get_right result)).delta <- 0 (*il etait à 1*)
		                           end
		                           else  (* 3eme cas oublié ds le Gaudel *)
		                           begin
		                             (get_node (get_left result)).delta <- 0; 
		                             (get_node (get_right result)).delta <- 0 
		                           end;
		                        (get_node result).delta<-0;
		                        (result,false)
		                      end
		                  end
		                end
		            end
		         else
		            begin
		              (get_node tr).right_son<- t1;
		              (tr,false)
		            end
		end
	in fst (insert2 k t);;
(* avl_insertion : int -> avl -> avl = <fun> *)


(* ---- routines graphiques propres aux avl ---- *)

type 'a cell_b = {mutable father_b:'a ptr_b ; mutable son_b:'a ptr_b ; mutable item_b: 'a}
and 'a ptr_b = Nil_b | Box_b of 'a cell_b
and 'a queue_b = {mutable first_b:'a ptr_b ; mutable last_b: 'a ptr_b};;
  
let pointed_value_b=function
    Box_b(x) -> x
  | Nil_b    -> failwith "pointed_value : no Pointed value" ;;
	
let make_empty_queue_b () = {first_b=Nil_b ; last_b=Nil_b};;
    
let (is_empty_queue_b, push_b, pop_b, flush) = 
  let queue = ref(make_empty_queue_b ())
  in let is_empty_queue_temp () = ((!queue).first_b = Nil_b) && ((!queue).last_b = Nil_b)
  in let push_temp (it : avl)  =
    if (is_empty_queue_temp())
    then
      begin
        let new_box  = Box_b{father_b = Nil_b ; son_b = (!queue).first_b ; item_b = it} in
	(!queue).first_b <- new_box;
	(!queue).last_b  <- new_box
      end
    else
      begin
        let new_box  = Box_b {father_b = Nil_b ; son_b = (!queue).first_b ; item_b = it} in
	(pointed_value_b ((!queue).first_b)).father_b <- new_box;
       	(!queue).first_b <- new_box
      end
  and pop_temp () =
    if (is_empty_queue_temp ())
    then
      failwith "pop_b : empty queue"
    else
      let pointed = pointed_value_b (!queue).last_b in
      if (!queue).first_b=(!queue).last_b
      then
    	begin
    	  (!queue).first_b<-Nil_b;
    	  (!queue).last_b <-Nil_b;
    	  pointed.item_b
    	end
      else let previous=pointed_value_b pointed.father_b in
      begin
    	previous.son_b <- Nil_b;
    	(!queue).last_b<-pointed.father_b;
    	pointed.item_b
      end
  and flush_temp () = (queue := make_empty_queue_b ())
  in (is_empty_queue_temp, push_temp, pop_temp, flush_temp);;
    
let rec deux_puis n =
  match n with
    0 -> 1
  | n -> 2 * deux_puis (n-1) ;;
	
let phantom = make_avl  0 (-1) (0 : color) (empty_avl()) (empty_avl ());;
    
let car l =
  match l with
    [] -> failwith "car"
  |x :: m -> x ;;
	
let cdr l =
  match l with
    [] -> failwith "cdr"
  |x :: m -> m ;; 
	
	
let make_liste tr =
  if (is_empty tr)
  then []
  else
    begin
      flush () ;
      push_b tr ;
      let l = ref([])
      and aux = ref (empty_avl())
      and h = (height tr) + 1
      in 
      for i=1 to (deux_puis(h)-1) do
	aux := pop_b () ;
	l := (get_key !aux, get_colour !aux) :: (!l) ;
	if not(is_empty (get_left !aux))
	then (push_b (get_left !aux))
	else (push_b phantom) ;
	if not(is_empty (get_right !aux))
	then (push_b (get_right !aux))
	else (push_b phantom) ;
      done ;
      !l
    end;;
    
type coord = {mutable x : int ; mutable y : int ; mutable exist : bool} ;;
    
let rec infix_list tr =     
  if (is_empty tr)
  then []
  else (infix_list (get_left tr))@[get_key tr]@(infix_list (get_right tr)) ;;
    
let racine_2_sur_2 = sqrt 2. /. 2. ;;
    
let make_circle x1 y1 c r n =
  set_color c ;
  fill_circle x1 y1 (int_of_float r) ;
  set_color black ;
  draw_circle x1 y1 (int_of_float r) ; 
  let n_size = text_size (string_of_int n)
  in moveto (x1 - (fst n_size)/2) (y1 - (snd n_size)/2) ;
  draw_string (string_of_int n) ;;
    
    
    
    
exception Too_large ;;    
    
let print_tree1 tr =
  clear_graph ();
  let l = make_liste tr
  in let ptr_l = ref (l)
  and h = height tr + 1
  in let j = deux_puis(h-1) - 1
  and aux = ref (0,0)
  and max_number_of_digits = List.fold_left max 0 (List.map fst (List.map text_size (List.map string_of_int (infix_list tr))))
  in let tab = Array.make (deux_puis(h)-1) (ref {x = 0 ; y = 0 ; exist = false}) 
  and r_int = int_of_float( sqrt ( float_of_int(max_number_of_digits * max_number_of_digits) /. 4. +. 81.)) + 2
  in let r_float = float_of_int r_int
  in let d = min 4 (max 0 (int_of_float((float_of_int(size_x())-.(2.*.float_of_int(j+1)+.1.)*.r_float)/.(3.*.float_of_int(j+1)-.1.))))
  in let d2 = 2*d ;
  in 
  if (h = 1)
  then
    begin
      aux := car(!ptr_l) ;
      tab.(j) <- ref {x = 0 ; y = 0 ; exist = (fst (!aux)<>(-1))} ;
      !(tab.(j)).x <- 2*r_int ;
      !(tab.(j)).y <- 2*r_int ;
      if fst (!aux)<>(-1)
      then 
	begin
	  make_circle !(tab.(j)).x !(tab.(j)).y (snd !aux) r_float (fst !aux) ;
	end ;
    end
  else
    begin
      for i = deux_puis (h-2) downto 1 do
	aux := car(!ptr_l) ;
	tab.(2*i+j-1) <- ref {x = 0 ; y = 0 ; exist = (fst (!aux)<>(-1))} ;
	!(tab.(2*i+j-1)).x <- i*4*r_int+i*d+(i-1)*d2;
	!(tab.(2*i+j-1) ).y <- 2*r_int ;
	if (!(tab.(2*i+j-1)).x > size_x()) or (!(tab.(2*i+j-1)).y > size_y())
	then raise Too_large ;
	if fst (!aux)<>(-1)
	then 
	  begin
	    make_circle !(tab.(2*i+j-1)).x !(tab.(2*i+j-1)).y (snd !aux) r_float (fst !aux) ;
	  end ;
	ptr_l := cdr (!ptr_l) ;
	aux := car(!ptr_l) ;
	tab.(2*i+j-2) <- ref {x = 0 ; y = 0 ; exist = (fst (!aux)<>(-1))} ;
	!(tab.(2*i+j-2)).x <- (2*i-1)*2*r_int+(i-1)*d2+(i-1)*d ;
	!(tab.(2*i+j-2)).y <- 2*r_int ;
	if fst (!aux)<>(-1)
	then 
	  begin
	    make_circle !(tab.(2*i+j-2)).x !(tab.(2*i+j-2)).y (snd !aux) r_float (fst !aux) ;
	  end ;
	ptr_l := cdr (!ptr_l) ;
      done ;
      for i = j downto 1 do
	aux := car (!ptr_l) ;
	tab.(i-1) <- ref {x = 0 ; y = 0 ; exist = (fst (!aux)<>(-1))} ;
	!(tab.(i-1)).y <- !(tab.(2*i-1)).y + 6*r_int ;
	!(tab.(i-1)).x <- (!(tab.(2*i-1)).x + !(tab.(2*i)).x) / 2 ;
	if fst (!aux)<>(-1)
	then 
	  begin 
	    make_circle !(tab.(i-1)).x !(tab.(i-1)).y (snd !aux) r_float (fst !aux) ;
	    if !(tab.(2*i-1)).exist
            then 
	      begin
		moveto !(tab.(i-1)).x (!(tab.(i-1)).y-r_int) ;
		lineto !(tab.(2*i-1)).x (!(tab.(2*i-1)).y+r_int) ;
              end ;
            if !(tab.(2*i)).exist
            then 
	      begin
		moveto !(tab.(i-1)).x (!(tab.(i-1)).y-r_int) ;
		lineto !(tab.(2*i)).x (!(tab.(2*i)).y+r_int) ;
              end ;
	  end ;
	ptr_l := cdr (!ptr_l) ;
      done 
    end;;
    
type coordinates_tree = Empty_c | Node_c of node_c
and node_c = {left_son_c: coordinates_tree ;
	      mutable x: int ;
              key_c : int ;
              colour_c : color ;
	      mutable y: int ;
	      right_son_c: coordinates_tree} ;;
    
let empty_c() = Empty_c ;;
    
let is_empty_c t = (t = empty_c()) ;;
    
let make_c left x_c n_c c_c y_c right = Node_c{left_son_c=left ; x = x_c ; colour_c = c_c ; key_c = n_c ; y = y_c ; right_son_c = right};;
    
let get_x tr_c =
  match tr_c with
  | Empty_c -> failwith "get_x"
  | Node_c(n) -> n.x ;;
	
let get_key_c tr_c =
  match tr_c with
  | Empty_c -> failwith "get_key_c"
  | Node_c(n) -> n.key_c ;;
	
let get_colour_c tr_c =
  match tr_c with
  | Empty_c -> failwith "get_colour_c"
  | Node_c(n) -> n.colour_c ;;
	
let get_y tr_c =
  match tr_c with
  | Empty_c -> failwith "get_y"
  | Node_c(n) -> n.y ;;
	
let get_left_son_c tr_c=
  match tr_c with
  | Empty_c -> failwith "get_left_son_c"
  | Node_c(n) -> n.left_son_c ;;
	
let get_right_son_c tr_c =
  match tr_c with
  | Empty_c -> failwith "get_right_son_c"
  | Node_c(n) -> n.right_son_c ;;
	
let rec left_length tr_c = 
  if is_empty_c tr_c
  then 0
  else
    begin
      if (is_empty_c (get_left_son_c tr_c)) && (is_empty_c (get_right_son_c tr_c))
      then 0
      else
	begin
	  if is_empty_c (get_left_son_c tr_c)
	  then max 0 (left_length (get_right_son_c tr_c) - (get_x (get_right_son_c tr_c)) + (get_x tr_c)) 
	  else
	    begin
	      if is_empty_c (get_right_son_c tr_c)
	      then (left_length (get_left_son_c tr_c) - (get_x (get_left_son_c tr_c)) + (get_x tr_c)) 
	      else max 0 (max (left_length (get_left_son_c tr_c) - (get_x (get_left_son_c tr_c)) + (get_x tr_c))
			    (left_length (get_right_son_c tr_c) - (get_x (get_right_son_c tr_c)) + (get_x tr_c))) 
	    end
	end
    end ;;  
    
    
let rec right_length tr_c =
  if is_empty_c tr_c
  then 0
  else 
    begin
      if (is_empty_c (get_left_son_c tr_c)) && (is_empty_c (get_right_son_c tr_c))
      then 0
      else
	begin
          if is_empty_c (get_left_son_c tr_c)
          then max 0 (right_length (get_right_son_c tr_c) + (get_x (get_right_son_c tr_c)) - (get_x tr_c)) 
          else
	    begin
              if is_empty_c (get_right_son_c tr_c)
              then max 0 (right_length (get_left_son_c tr_c) + (get_x (get_left_son_c tr_c)) - (get_x tr_c))
              else max 0 (max (right_length (get_left_son_c tr_c) + (get_x (get_left_son_c tr_c)) - (get_x tr_c))
                            (right_length (get_right_son_c tr_c) + (get_x (get_right_son_c tr_c)) - (get_x tr_c))) 
            end
        end  
    end ;;        
    
let change_x tr_c new_x =
  match tr_c with
    Empty_c -> failwith "change_x"
  |Node_c(n) -> (n.x <- new_x) ;;
	
let change_y tr_c new_y =
  match tr_c with
    Empty_c -> failwith "change_y"
  |Node_c(n) -> (n.y <- new_y) ;;
	
let rec push_right tr_c n =
  if (is_empty_c tr_c)
  then ()
  else
    begin
      change_x tr_c ((get_x tr_c)+n) ;
      push_right (get_left_son_c tr_c) n ;
      push_right (get_right_son_c tr_c) n ;
    end ;;
    
let rec push_up tr_c n = 
  if (is_empty_c tr_c)
  then ()
  else
    begin
      change_y tr_c ((get_y tr_c)+n) ;
      push_up (get_left_son_c tr_c) n ;
      push_up (get_right_son_c tr_c) n ;
    end ;;
    
    
let rec make_tr_c tr r y=
  if is_empty tr 
  then empty_c ()
  else 
    begin
      if (is_empty (get_left tr) && is_empty (get_right tr))
      then make_c (empty_c()) (2*r) (get_key tr) (get_colour tr) (2*r) (empty_c())
      else 
	begin
	  if is_empty (get_left tr)
	  then 
	    begin
              let tr_c_right = make_tr_c (get_right tr) r y
              in let x_c = get_x tr_c_right
              in if x_c < (3 * r)          
              then push_right tr_c_right (3*r - x_c) ;
              make_c (empty_c ()) ((get_x tr_c_right) - r) (get_key tr) (get_colour tr) ((get_y tr_c_right) + y) tr_c_right ;
	    end
          else
	    begin
              if is_empty (get_right tr)
              then
		begin
                  let tr_c_left = make_tr_c (get_left tr) r y
                  in make_c tr_c_left ((get_x tr_c_left) + r) (get_key tr) (get_colour tr) ((get_y tr_c_left) + y) (empty_c ()) ;
                end
              else
		begin
                  let tr_c_right = make_tr_c (get_right tr) r y
                  and tr_c_left = make_tr_c (get_left tr) r y
                  in let l_right = ref (right_length tr_c_left)
                  and h_right = height (get_right tr) + 1
                  and h_left = height (get_left tr) + 1
                  in if h_right > h_left
                  then push_up tr_c_left ((h_right - h_left)*y)
                  else
		    begin
                      if h_right < h_left
                      then push_up tr_c_right ((h_left - h_right)*y)
                    end ;
		  let d = ref 0 in
		  if ((is_empty_c (get_left_son_c tr_c_left)) && (is_empty_c (get_right_son_c tr_c_left))) || ((is_empty_c (get_left_son_c tr_c_right)) && (is_empty_c (get_right_son_c tr_c_right)))
		  then
		    begin
		      push_right tr_c_right ((get_x tr_c_left) - (get_x tr_c_right) + 2 * r) ;
		      if ((get_x tr_c_right) - (left_length tr_c_right) - r) < r
		      then (d := 2 * r -(get_x tr_c_right) + (left_length tr_c_right))
		    end
		  else push_right tr_c_right ((get_x  tr_c_left) + !l_right) ; (* +r-r *)
		  let res = make_c tr_c_left (((get_x tr_c_left)+(get_x tr_c_right))/2) (get_key tr) (get_colour tr) ((get_y tr_c_left)+y) tr_c_right in
		  if (!d <>0)
		  then push_right res (!d) ;
		  res
                end
            end
        end
    end ;;
    
let print_tree2 tr =
  clear_graph ();
  let max_number_of_digits = List.fold_left max 0 (List.map fst (List.map text_size (List.map string_of_int (infix_list tr))))
  in let r_int = int_of_float( sqrt ( float_of_int(max_number_of_digits * max_number_of_digits) /. 4. +. 81.)) + 2
  in let r_float = float_of_int r_int
  in let rec draw2 tr_c r =
    if is_empty_c tr_c
    then ()
    else
      begin
	make_circle (get_x tr_c) (get_y tr_c) (get_colour_c tr_c) (float_of_int r) (get_key_c tr_c) ;
        if not(is_empty_c (get_left_son_c tr_c))
        then
	  begin
            moveto (get_x tr_c) ((get_y tr_c)-r)  ;
            lineto (get_x (get_left_son_c tr_c)) ((get_y (get_left_son_c tr_c))+r)   ;
          end ;
        if not(is_empty_c (get_right_son_c tr_c))
        then
	  begin
            moveto (get_x tr_c) ((get_y tr_c)-r)  ;
            lineto (get_x (get_right_son_c tr_c)) ((get_y (get_right_son_c tr_c))+r) ;
          end ;
        draw2 (get_left_son_c tr_c) r ;
        draw2 (get_right_son_c tr_c) r ;
      end
  in 
  if (height tr = 0)
  then  draw2 (make_tr_c tr r_int  (6*r_int) ) r_int
  else    draw2 (make_tr_c tr r_int (min (6*r_int) (int_of_float(((float_of_int(size_y()-15)-.(2.*.r_float))/.(float_of_int(height tr))))))) r_int ;;
    
    
(*    open_graph " 1000x1000" ;;*)
    
let draw_tree_avl tr =
  try
    print_tree1 tr ;
  with
    Too_large -> print_tree2 tr ;;


(* ---- création d'exemples ---- *)

let rec succ_insertion=function
	[] -> Empty
	| a::r -> avl_insertion a (succ_insertion r);;
(*succ_insertion : int list -> avl = <fun>*)

	
let rec random_list n m=if n=0 then [] else (Random.int m)::(random_list (n-1) m);;
(*random_list : int -> int -> int list = <fun>*)

let big_test n=let tree=succ_insertion (random_list n (10*n)) in
	begin
	  tag tree magenta;
	  draw_tree_avl tree
	end;;
(*big_test : int -> unit = <fun>*)


let lovely_example()  =
  let t=[|12;3;2;5;4;7;9;11;14;10|] in
  let aux = ref (empty_avl()) in
    for i = 0 to 9
    do
      begin
	aux:=avl_insertion (t.(i)) !aux;
	draw_tree_avl (!aux);
	for i=1 to 10000000 do () done;
	tag (!aux) cyan;
      end
    done;
    tag (!aux) cyan;
    draw_tree_avl (!aux);;


(*
open_graph " 1000x1000";;
big_test 50 ;;
while not(key_pressed()) do
()
done ;;
*)