(* ---------------------------- Toolbox : arbres binaires ------------------------------------ *)

# use "FIFO.ml";; (*il faut la toolbox files pour le parcours en largeur*) 
open Graphics ;;


(* ---- Définition ---- *)

type binary_tree = Empty_b | Node_b of node_b
	and node_b = {mutable key_b : int ; mutable colour_b : color ;
	 mutable left_son_b : binary_tree  ; mutable right_son_b : binary_tree};;
	 
	 
(* ---- Constructeurs et destructeurs de base ---- *)

let empty_b() = Empty_b;;
(*empty_b : unit -> binary_tree = <fun>*)

let is_empty_b tree = match tree with
	Empty_b -> true
	| _ -> false ;;
(*is_empty_b : binary_tree -> bool = <fun>*)

let make_b k c l r =
	Node_b{key_b = k ; colour_b = c ; left_son_b = l ; right_son_b = r};;
(*int -> color -> binary_tree -> binary_tree -> binary_tree = <fun>*)

let get_node_b tree = match tree with
	Empty_b -> failwith "get_node_b : Empty binary_tree"
	| Node_b n -> n;;
(*get_node_b : binary_tree -> node_b = <fun>*)

let get_key_b tree = match tree with
	Empty_b -> failwith "get_key_b : Empty binary_tree"
	| Node_b{key_b = k} -> k;;
(*get_key_b : binary_tree -> int = <fun>*)

let get_colour_b tree = match tree with
	Empty_b -> failwith "get_colour_b : Empty binary_tree"
	| Node_b{colour_b = c} -> c;;
(*get_colour_b : binary_tree -> color = <fun>*)
	
let get_left_son_b tree = match tree with
	Empty_b -> failwith "get_left : Empty binary_tree"
	| Node_b{left_son_b = l} -> l;;
(*get_left_son_b : binary_tree -> binary_tree = <fun>*)

let get_right_son_b tree = match tree with
	Empty_b -> failwith "get_right : Empty binary_tree"
	| Node_b{right_son_b = r} -> r;;
(*get_right_son_b : binary_tree -> binary_tree = <fun>*)

let rec height_b t =
if (is_empty_b t) then (-1)
else 1 + (max (height_b (get_left_son_b t)) (height_b (get_right_son_b t)));;
(*height_b : binary_tree -> int = <fun>*)


(* ---- Recherche d'une clef dans un ABR ---- *)
(*coloration des noeuds visités en c1=color, de l'éventuel noeud trouvé en c2 = color*)

exception Found of node_b;;

let colorize nd c =
	nd.colour_b <- c;;
(*colorize : node_b -> color -> unit = <fun>*)

let rec search_bis k t c1 =
	if is_empty_b t then ()
	else
		begin
			let nd = get_node_b t in
			colorize nd c1;
			if (nd.key_b = k) then raise (Found nd)
			else 
				if (nd.key_b > k) then search_bis k (get_left_son_b t) c1
				else
					search_bis k (get_right_son_b t) c1
		end;;

let search k t c1 c2 =
	(try
		(search_bis k t c1)
	with
		Found(nd) -> colorize nd c2);;
		
(*search_bis : int -> binary_tree -> color -> unit = <fun>*)
(*search : int -> binary_tree -> color -> color -> unit = <fun>*)		

(*compteur*)

let make_counter () =
  let c = ref (0) in
		((function () -> (c := 0)) ,
		 (function () -> (c := !c + 1)) ,
		 (function () -> (!c) ));;

(*recherche avec compteur*)

let rec search_bis k t c1 tick=
	if is_empty_b t then ()
	else
		begin
			let nd = get_node_b t in
			colorize nd c1;
			tick();
			if (nd.key_b = k) then raise (Found nd)
			else 
				if (nd.key_b > k) then search_bis k (get_left_son_b t) c1 tick
				else
					search_bis k (get_right_son_b t) c1 tick
		end;;

let search k t c1 c2 =
let (init,tick,get)=make_counter() in
	begin
	init();
	(try
		(search_bis k t c1 tick)
	with
		Found(nd) -> colorize nd c2);
	get()
	end;;

(*search_bis : int -> binary_tree -> color -> (unit -> 'a) -> unit = <fun>*)
(*search : int -> binary_tree -> color -> color -> int = <fun>*)


	
(* ---- Fabrication d'exemples ---- *)


let real_life_binary_tree ()=
	make_b 11 cyan
	(make_b  4 cyan
	 (make_b 2 cyan 
	  (make_b  1 cyan (empty_b ()) (empty_b ()))
	  (make_b  3 cyan (empty_b ()) (empty_b ()))
	 )
	 (make_b  6 cyan
	  (make_b 5 cyan (empty_b ()) (empty_b ()))
	  (make_b  8 cyan	 
	   (make_b  7 cyan (empty_b ()) (empty_b ()))
	   (make_b  9 cyan (empty_b ()) (empty_b ()))
	  )
	 )
	)
	(make_b 20 cyan
	 (make_b  15 cyan
	  (make_b  12 cyan (empty_b ()) (empty_b ()))
	  (make_b 17 cyan (empty_b ()) (empty_b ()))
	 )
	 (make_b  21 cyan (empty_b ()) (empty_b ()))
	);;
(*real_life_binary_tree : unit -> binary_tree = <fun>*)

(*coloration de tout un arbre en même temps*)
let rec tag_b t c =
    if not (is_empty_b t) then let nd = get_node_b t in
        begin
            nd.colour_b <- c;
            tag_b nd.left_son_b c;
            tag_b nd.right_son_b c
        end;;
(*tag_b : binary_tree -> color -> unit = <fun>*)

(*création d'un ABR par insertion successives aux feuilles*)
let rec brt_insertion k t =
    if (is_empty_b t) then 
        make_b k cyan (empty_b()) (empty_b())
    else
        if (k = (get_key_b t)) then t
        else if (k < (get_key_b t)) then 
                let result = brt_insertion k (get_left_son_b t) in
                begin
                  (get_node_b t).left_son_b <- result;
                  t
                end
         else let result = brt_insertion k (get_right_son_b t) in
                 begin
                   (get_node_b t).right_son_b <- result;
                   t
                 end;;
 (*brt_insertion : int -> binary_tree -> binary_tree = <fun>*)
 
 let rec succ_insertion_b = function
     [] -> Empty_b
   | a::r -> brt_insertion a (succ_insertion_b r);;
 (*succ_insertion_b : int list -> binary_tree = <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_brt n =
 let random_tree = succ_insertion_b (random_list (n-1) (10*n)) in
     begin
          tag_b random_tree cyan;
          random_tree
     end;;
 (*big_brt : int -> binary_tree = <fun>*)
     
(* ---- Illustrations ---- *)

(*let ex = real_life_binary_tree();;
draw_binary_tree ex;;
graphic_search 9 ex green red;;
search_n_init 9 ex ;;

let ex2 = big_brt 50;;
graphic_search 40 ex2 green red;; *)

let stat_brt nt nn = (*nt = nb tests et nn = nb noeuds*)
    let sigma = ref(0) in
       begin
           for i=1 to nt do
           sigma:= !sigma + (height_b (succ_insertion_b (random_list nn (5*nn))))
           done;
           (float_of_int !sigma) /. (float_of_int nt)
       end;;
(*hauteur moyenne d'abr construits aléatoirement par insertion aux feuilles*)
(*stat_brt : int -> int -> float = <fun>*)

let make_n_search_brt nt nn = 
    let sigma = ref(0) in
        begin
            for i=1 to nt do
                let tree = big_brt nn in
                for i=1 to 100 do
                sigma := !sigma + (search (Random.int (5*nn)) tree cyan cyan)
                done;
                done;
                (float_of_int !sigma) /. (float_of_int (100*nt))
         end;;
(*make_n_search_brt : int -> int -> float = <fun>*)


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 : binary_tree)  =
    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_b = make_b  (-1) (0 : color) (empty_b()) (empty_b ());;
    
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_b tr)
  then []
  else
    begin
      flush () ;
      push_b tr ;
      let l = ref([])
      and aux = ref (empty_b())
      and h = (height_b tr) + 1
      in 
      for i=1 to (deux_puis(h)-1) do
	aux := pop_b () ;
	l := (get_key_b !aux, get_colour_b !aux) :: (!l) ;
	if not(is_empty_b (get_left_son_b !aux))
	then (push_b (get_left_son_b !aux))
	else (push_b phantom_b) ;
	if not(is_empty_b (get_right_son_b !aux))
	then (push_b (get_right_son_b !aux))
	else (push_b phantom_b) ;
      done ;
      !l
    end;;
    
type coord = {mutable x : int ; mutable y : int ; mutable exist : bool} ;;
    
let rec infix_list tr =     
  if (is_empty_b tr)
  then []
  else (infix_list (get_left_son_b tr))@[get_key_b tr]@(infix_list (get_right_son_b 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_b 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_b tr 
  then empty_c ()
  else 
    begin
      if (is_empty_b (get_left_son_b tr) && is_empty_b (get_right_son_b tr))
      then make_c (empty_c()) (2*r) (get_key_b tr) (get_colour_b tr) (2*r) (empty_c())
      else 
	begin
	  if is_empty_b (get_left_son_b tr)
	  then 
	    begin
              let tr_c_right = make_tr_c (get_right_son_b 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_b tr) (get_colour_b tr) ((get_y tr_c_right) + y) tr_c_right ;
	    end
          else
	    begin
              if is_empty_b (get_right_son_b tr)
              then
		begin
                  let tr_c_left = make_tr_c (get_left_son_b tr) r y
                  in make_c tr_c_left ((get_x tr_c_left) + r) (get_key_b tr) (get_colour_b tr) ((get_y tr_c_left) + y) (empty_c ()) ;
                end
              else
		begin
                  let tr_c_right = make_tr_c (get_right_son_b tr) r y
                  and tr_c_left = make_tr_c (get_left_son_b tr) r y
                  in let l_right = ref (right_length tr_c_left)
                  and h_right = height_b (get_right_son_b tr) + 1
                  and h_left = height_b (get_left_son_b 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_b tr) (get_colour_b 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_b 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_b tr))))))) r_int ;;
    
    
(*    open_graph " 1000x1000" ;;*)
    
let draw_binary_tree tr =
  try
    print_tree1 tr ;
  with
    Too_large -> print_tree2 tr ;;
	
(*bidule*)
(*bidule5*)
(*25*)
(*let bidule = big_brt 4 ;;
let bidule2 = make_b 30 cyan (Empty_b) bidule ;;
let truc = big_brt 7 ;;
let bidule3 = make_b 76 cyan truc (big_brt 3) ;;
let bidule4 = make_b 59 cyan bidule3 Empty_b ;;
let bidule5 = make_b 87 cyan bidule4 Empty_b ;;

close_graph () ;;
open_graph " 800x800" ;;
print_tree1 bidule5 ;;*)

(* ---- Parcours graphiques ---- *)

(*profondeur prefixe*)

let deep_first_graphic tree = 
   let rec deep_first_graphic_bis tr =
	if is_empty_b tr then ()
	else
		begin
			colorize (get_node_b tr) red;
			draw_binary_tree tree;
			for i=1 to 3000000 do () done;
			deep_first_graphic_bis (get_left_son_b tr) ;
			deep_first_graphic_bis (get_right_son_b tr)
		end
	in deep_first_graphic_bis tree;;
(*deep_first_graphic : binary_tree -> unit = <fun>*)

(*largeur prefixe*)

let bread_first_graphic tree =
	let aux = make_empty_queue() in
		begin
			push tree aux;
			while not(is_empty_queue aux) do
				let res = pop aux in
					begin
						colorize (get_node_b res) red;
						draw_binary_tree tree;
						for i=1 to 3000000 do () done;
						if not(is_empty_b (get_left_son_b res)) then push (get_left_son_b res) aux;
						if not(is_empty_b (get_right_son_b res)) then push (get_right_son_b res) aux;
					end
			done
		end;;
(*bread_first_graphic : binary_tree -> unit = <fun>*)


(*recherche graphique*)

let graphic_search_aux k t c1 =
	let rec graphic_search_aux2 k tr c1 =
	if is_empty_b tr then ()
	else
		begin
			let nd = get_node_b tr in
			colorize nd c1;
			draw_binary_tree t;
			for i=1 to 4000000 do () done;
			if (nd.key_b = k) then raise (Found nd)
			else 
				if (nd.key_b > k) then graphic_search_aux2  k (get_left_son_b tr) c1
				else
					graphic_search_aux2 k (get_right_son_b tr) c1
		end
	in graphic_search_aux2 k t c1;;

let graphic_search k t c1 c2 =
	(try
		(graphic_search_aux k t c1)
	with
		Found(nd) -> 
			begin
				colorize nd c2;
				draw_binary_tree t
			end);;

	
let search_n_init k t = search k t cyan cyan ;;
(*search_n_init : int -> binary_tree -> unit = <fun>*)