type Noeud={
  mutable etiquette:int;
  mutable gauche:ArbreBinaire;
  mutable droit:ArbreBinaire}
and ArbreBinaire=ArbreVide | Pointeur of Noeud;;


let est_vide=function
     ArbreVide -> true
   | _          -> false;;
   
let noeud=function
     ArbreVide -> failwith "arbre vide"
   | Pointeur x -> x;;
   
   
let echange_gauche_droit a=
  if not(est_vide a) then
  let temp=(noeud a).gauche in
    (noeud a).gauche<-(noeud a).droit;
    (noeud a).droit<-temp;;
        
    
(* I.B.1.a  *)


let rotation_gauche a=
  if est_vide a then a
  else let fd=(noeud a).droit in
       if est_vide fd then a
       else begin
      		  (noeud a).droit<-(noeud fd).gauche;
      		  (noeud fd).gauche<-a;
              fd
            end;;
(* Si on veut absolument pattern matcher...

let rotation_gauche a=match a with
  | ArbreVide -> a
  | Pointeur x->let fd=x.droit in
       if est_vide fd then a
       else begin
      		  x.droit<-(noeud fd).gauche;
      		  (noeud fd).gauche<-a;
              fd
            end;;
*)         
         
(*  I.B.1.b  *)

let rotation_droite a=
  if est_vide a then a
  else let fg=(noeud a).gauche in
       if est_vide fg then a
       else begin
      		  (noeud a).gauche<-(noeud fg).droit;
      		  (noeud fg).droit<-a;
              fg
            end;;
 
   
(* I.B.3.a *)

let rotation_gauche_droite a=
  if (est_vide a)||(est_vide (noeud a).gauche)
    ||(est_vide (noeud (noeud a).gauche).droit)
    then a else
      begin
        (noeud a).gauche<-rotation_gauche (noeud a).gauche;
        rotation_droite a
      end;;
  
(* I.B.3.b *)

let exemple ()=Pointeur
  {etiquette=4;
   gauche=Pointeur
     {etiquette=2;
      gauche=Pointeur
        {etiquette=1;
         gauche=ArbreVide;
         droit=ArbreVide};
      droit=Pointeur
        {etiquette=3;
         gauche=ArbreVide;
         droit=ArbreVide}};
   droit=Pointeur
     {etiquette=6;
      gauche=Pointeur
        {etiquette=5;
         gauche=ArbreVide;
         droit=ArbreVide};
      droit=Pointeur
        {etiquette=7;
         gauche=ArbreVide;
         droit=ArbreVide}}};;
         
         
echange_pere_gauche (exemple ());;
rotation_gauche_droite (exemple ());;
 

let rotation_droite_gauche a=
  if (est_vide a)||(est_vide (noeud a).droit)
    ||(est_vide (noeud (noeud a).droit).gauche)
    then a else
      begin
        (noeud a).droit<-rotation_droite (noeud a).droit;
        rotation_gauche a
      end;;
      
rotation_droite_gauche (exemple ());;
  

(* I.C.1 *)
 
type Couleur= Blanc | Noir;;

type Noeud={
  mutable etiquette:int;
  mutable pere:ArbreBinaire;
  mutable couleur:Couleur;
  mutable gauche:ArbreBinaire;
  mutable droit:ArbreBinaire}
and ArbreBinaire=ArbreVide | Pointeur of Noeud;;

let est_vide=function
     ArbreVide -> true
   | _          -> false;;
   
let noeud=function
     ArbreVide -> failwith "arbre vide"
   | Pointeur x -> x;;
   
let change_pere a p=if not(est_vide a) then (noeud a).pere<-p;;
let connecter nouv anc=if not(est_vide (noeud nouv).pere)
    then if anc=(noeud (noeud nouv).pere).droit
            then (noeud (noeud nouv).pere).droit<-nouv
            else (noeud (noeud nouv).pere).gauche<-nouv;;
    
let rotation_gauche a=
  if est_vide a then a
  else let fd=(noeud a).droit in
       if est_vide fd then a
       else
         begin
    	   (noeud a).droit<-(noeud fd).gauche;
    	   change_pere (noeud fd).gauche a;
           (noeud fd).gauche<-a;
           change_pere fd (noeud a).pere;
           change_pere a fd;
           connecter fd a;
           fd
         end;;
         
let rotation_droite a=
  if est_vide a then a
  else let fg=(noeud a).gauche in
       if est_vide fg then a
       else begin
      		  (noeud a).gauche<-(noeud fg).droit; 
	    	  change_pere (noeud fg).droit a;
      		  (noeud fg).droit<-a;
	          change_pere fg (noeud a).pere;
	          change_pere a fg;
	          connecter fg a;
              fg
            end;;
 
 
let rotation_gauche_droite a=
  if (est_vide a)||(est_vide (noeud a).gauche)
    ||(est_vide (noeud (noeud a).gauche).droit)
    then a else let g=rotation_gauche (noeud a).gauche
    in begin
         (noeud a).gauche<-g;
         rotation_droite a
       end;;

let rotation_droite_gauche a=
  if (est_vide a)||(est_vide (noeud a).droit)
    ||(est_vide (noeud (noeud a).droit).gauche)
    then a else let d=rotation_droite (noeud a).droit
    in begin
         (noeud a).droit<-d;
         rotation_gauche a
       end;;

(* I.C.3 *)
 
let rec inserer_arbre_binaire a e=match a with
 	| ArbreVide->Pointeur
 			{etiquette=e;couleur=Blanc;pere=ArbreVide;
 			droit=ArbreVide; gauche=ArbreVide}
 	| Pointeur b->if b.etiquette>=e
 		then let g=inserer_arbre_binaire b.gauche e
 		     in begin
 		          if b.gauche=ArbreVide then
 		          ( (noeud g).pere<-a; b.gauche<-g);
 		          g
 		        end
 		else let d=inserer_arbre_binaire b.droit e
 			 in begin
 			      if b.droit=ArbreVide then
 			      ( (noeud d).pere<-a; b.droit<-d);
 			      d
 			    end;;
 			    
let n=ref (inserer_arbre_binaire  ArbreVide 10);;
n:=inserer_arbre_binaire !n 15;;
!n;;

type Noeud2={
  mutable etiquette2:int;
  mutable couleur2:Couleur;
  mutable gauche2:ArbreBinaire2;
  mutable droit2:ArbreBinaire2}
and ArbreBinaire2=ArbreVide2 | Pointeur2 of Noeud2;;

let rec paricide=function
  | ArbreVide -> ArbreVide2
  | Pointeur a-> Pointeur2
  	{etiquette2= a.etiquette;
  	 couleur2= a.couleur;
  	 gauche2=paricide a.gauche;
  	 droit2=paricide a.droit};;
 

let l1=[1;2;3;4;5;6;7;8];;	 
  	 
let creation_binaire l=it_list
  (fun a e->inserer_arbre_binaire a e) ArbreVide l;;

let rec adam a=if (noeud a).pere=ArbreVide then a
        else adam (noeud a).pere;;
      
paricide (adam (creation_binaire l1));;
paricide (adam (creation_binaire (rev l1)));;


(* insertion bicolore *)

let coul=function
    | ArbreVide  -> Noir
    | Pointeur a -> a.couleur;;
    
  
let inserer_arbre_bicolore a e=
  let n=ref (inserer_arbre_binaire a e) in
  if est_vide a then (noeud !n).couleur<-Noir (* b *)
  else while (noeud !n).couleur=Blanc
  do let p=(noeud !n).pere in
    if p=ArbreVide then (noeud !n).couleur<-Noir
    else if (noeud p).couleur=Noir then n:=p (* pour sortir *)
    else let q=(noeud p).pere in
    match ((noeud q).gauche=p),((noeud p).gauche= !n) with
    | true,true ->    (* Cas 1 *)
       if coul (noeud q).droit=Blanc
         then begin
                (noeud q).couleur<-Blanc;
                (noeud p).couleur<-Noir;
                (noeud (noeud q).droit).couleur<-Noir;
                n:=q
              end
         else begin
         		(noeud q).couleur<-Blanc;
         		n:=rotation_droite q;
                (noeud !n).couleur<-Noir
              end
    | false,false ->   (* Cas 4 *)
       if coul (noeud q).gauche=Blanc
         then begin
                (noeud q).couleur<-Blanc;
                (noeud p).couleur<-Noir;
                (noeud (noeud q).gauche).couleur<-Noir;
                n:=q
              end
         else begin
         		(noeud q).couleur<-Blanc;
         		n:=rotation_gauche q;
                (noeud !n).couleur<-Noir
              end
    | true,false ->    (* Cas 2 *)
       if coul (noeud q).droit=Blanc
         then begin
                (noeud q).couleur<-Blanc;
                (noeud p).couleur<-Noir;
                (noeud (noeud q).droit).couleur<-Noir;
                n:=q
              end
         else begin
         		(noeud p).couleur<-Noir;
         		n:=rotation_gauche_droite q
              end
    | false,true ->    (* Cas 3 *)
       if coul (noeud q).gauche=Blanc
         then begin
                (noeud q).couleur<-Blanc;
                (noeud p).couleur<-Noir;
                (noeud (noeud q).gauche).couleur<-Noir;
                n:=q
              end
         else begin
         		(noeud p).couleur<-Noir;
         		n:=rotation_droite_gauche q
              end;
  done;
  adam !n;;


let creation_bicolore l=it_list
  (fun a e->inserer_arbre_bicolore a e) ArbreVide l;;

paricide (creation_bicolore l1);;
paricide (creation_bicolore (rev l1));;

paricide (creation_bicolore [10;5;7]);; (* pour tester le cas 2 *)


let rec random_list p=function
    | 0-> []
    | n -> (random__int p)::(random_list p (n-1));;

let test_bicolore n=paricide (
   creation_bicolore (random_list (5*n) n));;
   
test_bicolore 10;;

let rec affichage=function
    | ArbreVide2 -> ()
    | Pointeur2 n->
       begin
         print_string "(";
         affichage n.gauche2;
         print_int n.etiquette2;
         affichage n.droit2;
         print_string ")";
       end;;
       
affichage (test_bicolore 30);;