(*		TD ARBRES		*)

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

#open "graphics";;

open_graph "";;

let draw_int x y i =
      set_color red;
      draw_string (string_of_int i);
      moveto x y;
      set_color black;;

let rec dessin x y h l  = function
(* coordonnees de la racine, hauteur, largeur *)
  | V ->()
  | N(i,g,d) ->
   let xg = (x-.(l/.2.)) and yg = y -. h
   and xd = x +. (l/.2.) and yd = y -. h in
      moveto (int_of_float x) (int_of_float y);
      draw_int (int_of_float x) (int_of_float y) i;
      if g<>V  then begin moveto (int_of_float x) (int_of_float y);
      lineto (int_of_float xg) (int_of_float yg);
      dessin  xg yg (2. *. h /. 3.) (l /.2.) g end;
      if d<>V  then begin moveto (int_of_float x) (int_of_float y);
      lineto (int_of_float xd) (int_of_float yd);
      dessin  xd yd (2. *. h /. 3.) (l /.2.) d end
   ;;


let dessin_arbre t =
   clear_graph ();
   let y_max = 0.9 *. (float_of_int (size_y ())) in
   let h = (y_max /. 3.) in
   dessin (float_of_int ((size_x ())/2))
          ((float_of_int (size_y ()))*.0.9)
          h h t;;



let ex1=N(17,N(8,N(6,V,V),N(12,V,N(13,V,N(14,V,V)))),
		N(23,N(19,N(18,V,V),V),V));;
		
dessin_arbre ex1;;

(*--------------------------------------------------------------

	EXERCICE 1 : FONCTIONS DE BASE

--------------------------------------------------------------*)

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

hauteur ex1;;
(* - : int = 4 *)

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

nb_feuilles ex1;;
(* - : int = 3 *)

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

nb_noeuds ex1;;
(* - : int = 9 *)


(* 2- peignes + arbre complet *)

let rec peigne h=peigne_commencant 0 h
	where rec peigne_commencant r=function
		| 0 -> N(r,V,V)
		| hh -> N(r, peigne_commencant (r+2) (hh-1), N(r+1,V,V));;
peigne 2;;
(* - : int arbre = N (0, N (2, N (4, V, V), N (3, V, V)), N (1, V, V)) *)


let rec complet h=complet_commencant 1 h
     where rec complet_commencant r=function
	| 0 -> N(r,V,V)
	| hh -> N(r,complet_commencant (2*r) (hh-1),complet_commencant (2*r+1) (hh-1));;

complet 2;;
(*  N (1, N (2, N (4, V, V), N (5, V, V)), N (3, N (6, V, V), N (7, V, V))) *)

(* 3- miroir *)

let rec miroir=function
	| V -> V
	| N(x,g,d)->N(x,miroir d,miroir g);;

dessin_arbre (miroir ex1);;
(* ca marche...*)


(*----------------------------------------------------------------

	EXERCICE 2 : PARCOURS

----------------------------------------------------------------*)

(* 1- Parcours linéaire infixe et préfixe en récursif *)

let rec liste_infixe =function
	| V->[]
	| N(a,fg,fd)-> (liste_infixe fg)@(a::(liste_infixe fd));;
	
let in1=liste_infixe ex1;;
(*in1 : int list = [6; 8; 12; 13; 14; 17; 18; 19; 23]*)

let rec liste_prefixe =function
	| V->[]
	| N(a,fg,fd)-> a::(liste_prefixe fg)@(liste_prefixe fd);;
	
let pre1=liste_prefixe ex1;;
(*pre1 : int list = [17; 8; 6; 12; 13; 14; 23; 19; 18]*)

(* 2- Parcours linéaire infixe avec une pile *)

type 'a pile==('a list) ref;;
let Pile_vide ()= ref [];;
let push x p=(p:=x:: !p);;
let pop l=let x=hd !l in l:=tl !l;x;;
let est_vide l=(!l=[]);;

let infixe_2 a=let p=Pile_vide() in
	let etape ()=
	(match pop p with
		 V->()
		|N(x,V,V)->print_int x;print_string " "
		|N(x,fg,fd)->
		begin push fd p; push (N(x,V,V)) p; push fg p end)
	in push a p;
	   while not(est_vide(p)) do etape () done;;
	
infixe_2 ex1;;
(*6 8 12 13 14 17 18 19 23 - : unit = ()*)

let prefixe_2 a=let p=Pile_vide() in
	let etape ()=
	(match pop p with
		 V->()
		|N(x,V,V)->print_int x;print_string " "
		|N(x,fg,fd)->
		begin push fd p; push fg p; push (N(x,V,V)) p end)
	in push a p;
	   while not(est_vide(p)) do etape () done;;
	
prefixe_2 ex1;;
(*17 8 6 12 13 14 23 19 18 - : unit = ()*)


(* 3- la liste préfixe [1;2;3] peut correspondre à trois arbres... *)

(* 4- si les étiquettes sont distribuées injectivement, on va pouvoir reconstituer
l'arbre initial à partir des listes préfixes et infixes, en détectant la racine, et
avec quelques trinconnages *)

(* 5- Mettons cela en pratique *)

let rec cut1 l a=match l with
	| [] -> failwith "listes corrompues"
	| x::reste -> if x=a then [],reste
			else let g,d=cut1 reste a in x::g,d;;
(* cut1 l a scinde l grace à l'élément a *)

let rec cut2 l=function
	| 0->([],l)
	| k->let (g,d)=cut2 (tl l) (k-1) in ((hd l)::g,d);;

(* cut2 l t retourne l1,l2, où l1 contient les premiers éléments de l *)
				
let rec pre_inf2tree =function
	| ([],_)-> V
	|  (a::reste,l)->let (g2,d2)=cut1 l a in
		let (g1,d1)=cut2 reste (list_length g2)
		in N(a,pre_inf2tree (g1,g2),pre_inf2tree (d1,d2));;
		
		
ex1=pre_inf2tree (pre1,in1);;
(* - : bool = true *)




(*-----------------------------------------------------------

	EXERCICE 3 : ANALYSE LEXICALE

-----------------------------------------------------------*)

type arbre={Etiq:int; fils:arbre list};;
type Lex=PO|PF|Val of int;;

let rec arbre2exp a=PO::Val(a.Etiq)::(foret2exp a.fils)@[PF]
and foret2exp = function
	| [] -> []
	| a1::reste ->(arbre2exp a1)@(foret2exp reste);;

(*#arbre2exp {Etiq=12; fils=[{Etiq=23;fils=[]};{Etiq=13;fils=[]}]};;
- : Lex list = [PO; Val 12; PO; Val 23; PF; PO; Val 13; PF; PF]*)

let rec exp2arbre=function
	| PO::Val(e)::r->
		let (f,suite)=exp2foret r in ({Etiq=e; fils=f},suite)
	| _->failwith "erreur de syntaxe"
and exp2foret =function
	| PF::reste->([],reste)
	| l->let (premier,s)=exp2arbre l in
		 let (autres,a_suivre)=exp2foret s in (premier::autres,a_suivre);;
		 	 
(* exp2arbre : Lex list -> arbre * Lex list = <fun>
exp2foret : Lex list -> arbre list * Lex list = <fun>
#exp2arbre [PO;Val 12;PO;Val 23;PF;PO;Val 15;PO;Val 10;PF;PO;Val 11;PF;PF;
PO;Val 13;PF;PF];;
- : arbre * Lex list =
 {Etiq = 12;
  fils =
   [{Etiq = 23; fils = []};
    {Etiq = 15; fils = [{Etiq = 10; fils = []}; {Etiq = 11; fils = []}]};
    {Etiq = 13; fils = []}]}, [] *)