(* ---------------
     TD ABR 
   --------------- *) 

(* 
    EXERCICE 1
*)

type 'a arbre =V|N of int*('a arbre)*('a arbre);;
type ABR==int arbre;;

let verif_ABR a=
  let rec verif_bornes_ABR y1 y2=function 
    | V->true
    | N(z,g,d)->(z<=y2) && (y1<=z) &&
	(verif_bornes_ABR y1 z g) && (verif_bornes_ABR z y2 d) 
  in verif_bornes_ABR min_int max_int a;;
(* verif_ABR : 'a arbre -> bool = <fun> *)

let rec cherche x=function
  | V -> false
  | N(y,g,d)-> (x=y) ||  ((x<y) && (cherche x g)) || (cherche x d);;
(* cherche : int -> 'a arbre -> bool = <fun> *)


let rec insert1 x=function  (* Aux feuilles *) 
  | V -> N(x,V,V)
  | N(y,g,d)->if x<=y then N(y,insert1 x g,d) else N(y,g,insert1 x d);;
(* insert1 : int -> 'a arbre -> 'a arbre = <fun> *)

let build1 l=let rec build11=function
  | []->V
  | a::l->insert1 a (build11 l)
in build11 (rev l);;
(* build1 : int list -> 'a arbre = <fun> *)
(* NB : les vrais cameliens crient, mais c'est pas grave *)

build1 [2;1;8;5;4;3;6;7];;
(*
- : '_a arbre =
 N
  (2, N (1, V, V),
   N (8, N (5, N (4, N (3, V, V), V), N (6, V, N (7, V, V))), V))
D'après la caractérisation des ABR par la croissance de la liste
*)

let rec couper x=function
  | V->(V,V)
  | N(r,a1,d) when r>x->let (g1,d1)=couper x a1 in g1,N(r,d1,d)
  | N(r,g,a1)         ->let (g1,d1)=couper x a1 in N(r,g,g1),d1;;
(* couper : int -> 'a arbre -> 'a arbre * 'a arbre = <fun> *)

(* Insertion  aux feuilles : *)
let rec insert2 x a= let (g2,d2)=couper x a in N(x,g2,d2);;
(* insert2 : int -> 'a arbre -> 'a arbre = <fun>*)

let build2 l=let rec build21=function
  | []->V
  | a::l->insert2 a (build21 l)
in build21 (rev l);;
(* build2 : int list -> 'a arbre = <fun> *)

build2 [2;1;8;5;4;3;6;7];;
build1 [2;1;8;5;4;3;6;7]=build2 (rev [2;1;8;5;4;3;6;7]);;
(*- : '_a arbre =
 N
  (7, N (6, N (3, N (1, V, N (2, V, V)), N (4, V, N (5, V, V))), V),
   N (8, V, V))
- : bool = true *)


let rec suppression x a=if not cherche x a then a else 
let rec seek_n_destroy_min=function
  | V -> failwith "Ne peut pas arriver"
  | N(z,V,d)-> z,d
  | N(z,g,d)->let m,gg=seek_n_destroy_min g in m,N(z,gg,d)
in match a with
  | V -> failwith "Arbre vide dans supression"
  | N(y,g,d) when x<y ->N(y,suppression x g,d)
  | N(y,g,d) when x>y ->N(y,g,suppression x d)
  | N(y,g,V) -> g
  | N(y,g,d) -> let r,fd=seek_n_destroy_min d in N(r,g,fd);;
(* suppression : int -> 'a arbre -> 'a arbre = <fun>  *)             

suppression 3 (build2 [2;1;8;5;4;3;6;7]);;
(* - : '_a arbre =
 N (7, N (6, N (4, N (1, V, N (2, V, V)), N (5, V, V)), V), N (8, V, V))*)


(* 
    EXERCICE 3
*)

let test x l=let rec test_sentinelles m M=function
  | []-> true
  | y::l when y=x -> l=[]
  | y::reste ->  (y>=m) && (y<=M) &&
      ( ( (y>x) &&  (test_sentinelles  m y reste))
        || ( test_sentinelles y M reste))
in test_sentinelles min_int max_int l;;
    

test 2048 [100;140;4096;150;3000;2048];; (* true *)
test 2048 [100;150;4096;140;3000;2048];; (* false *)
test 2048 [4096;100;140;150;3000;2048];; (* true *)
test 2048 [100;150;140;4096;3000;2048];; (* false *)
test 2048 [3000;4096;140;150;100;2048];; (* false *)
test 2048 [100;140;4096;150;3000];;      (* true *)
test 2048 [2048;100;150;4096;140;3000];; (* false *)


(* 
    EXERCICE 4
*)


let rec fusion a1 a2=match a1,a2 with
  | V,_ -> a2
  | _,V -> a1
  | N(e1,g1,d1),N(e2,g2,d2) -> match (random__int 2) with
      |0 -> let g,d=couper e1 a2 in N(e1,fusion g1 g,fusion d1 d)
      |_ -> let g,d=couper e2 a1 in N(e2,fusion g2 g,fusion d2 d);;
(* fusion : 'a arbre -> 'a arbre -> 'a arbre = <fun> *)


let rec hauteur=function
	| V	   -> -1515
	| N(_,V,V) -> 0
	| N(_,g,d) -> 1+max (hauteur g) (hauteur d);;


for i=1 to 20
do
  print_int
    (hauteur (fusion (build1 [1;3;5;7;9;11;13;15;17;19]) (build1 [2;4;6;8;10;12;14;16;18;20])));
  print_string " "
done;;
(* 13 12 14 12 14 11 14 14 12 13 12 14 13 13 14 14 12 12 11 14 - : unit = () *)

for i=1 to 20
do
  print_int
    (hauteur (fusion (build1 [1;3;5;7;9;11;13;15;17;19]) (build2 [2;4;6;8;10;12;14;16;18;20])));
  print_string " "
done;;
(* 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 11 - : unit = ()  Expliquez !!*)

(* 
    EXERCICE 5
*)

let rec parcours=function
  | V->[]
  |N(x,g,d)->(parcours g)@(x::parcours d);;

let tri l=parcours (build1 l);;

tri [1;9;45;6;4;5;32;1515;17];;
(* - : int list = [1; 4; 5; 6; 9; 17; 32; 45; 1515]*)


(* Exercice 6 *)

let a=build1 [19;9;45;6;4;5;32;1515;17] in
  (suppression 9 (suppression 4 a))=(suppression 4 (suppression 9 a));;

(* - : bool = true

Au moment d'écrire la feuille de TD, je pensais que c'était faux. Après quelques
essais, j'étais convaincu que c'était vrai. 
1. Si ni x ni y n'est  ancetre de l'autre, ca commute trivialement.
2. On est donc ramené au cas où x est ancetre de y (par exple) et même racine
de l'arbre. Si on a utilisé un algo déterministe (rechercher/détruire le min du
fils droit systématiquement, par exple), ca commute trivialement dans un cas
(ici, lorsque y est dans la branche gauche). Si y est dans la branche droite,
ça va marcher aussi, mais il faut distinguer le cas où y est dans la descendance
du min du fils droit (puis s'il a des fils...) : faire de nombreux dessins. 
*)




(* 
    EXERCICE 7
*)


let rec inclus a1 a2=match a1 with
  | V -> true
  | N(e,g,d) -> let gg,dd=couper e a2 in (cherche e a2) && (inclus g gg) && (inclus d dd)
and equivalents a1 a2=(inclus a1 a2) && (inclus a2 a1);; 

(* A la truelle, en supposant tout le monde bien equilibré, avec même a1 et a2 de taille
equivalente, cet algorithme s'execute en temps A(n) verifiant A(n)=2ln(n)+2A(n/2)
donc A(2**p)/2**p =O(1) puis A(n) de l'ordre de n.

Un algo du genre : chercher chaque element de a1 dans a2 coutera plutôt nln(n)... *)

let gros_exemple n=let a1=ref V and a2=ref V and x=ref (random__int (10*n)) in
  (* ca va etre moche, mais bon... *)
  begin
    for i=1 to n
    do
      while (cherche !x !a1) do x:=random__int (10*n) done;
      a1:=insert1 !x !a1;
      a2:=insert2 !x !a2
    done;  
    !a1, !a2
  end;;


let a1,a2=gros_exemple 10000;; (* Ca demande quelques secondes... *)

hauteur a1,hauteur a2;; (* - : int * int = 27, 31 *)

inclus a1 a2;; (* - : bool = true : immédiat *)
inclus (insert1 17 a1) a2;; (* - : bool = false : immédiat *)

let rec inclus_naif a1 a2=match a1 with
  | V -> true
  | N(e,g,d) -> (cherche e a2)&&(inclus_naif g a2)&&(inclus_naif d a2);;
    
inclus_naif a1 a2;; (* - : bool = true : immédiat encore : c'est bien décevant...*)