let afficher_arbre t =
  let rec afficher depth t = match t with
    | Vide -> ()
    | Noeud (i, l, r) ->
        for i=0 to depth do print_string " " done;
        printf__printf "- %d\n" i;  (* affiche i *)
        afficher (depth+2) l;
        afficher (depth+2) r
  in
  afficher 2 t;;

let arbre_aleatoire () =
  let rec make depth =
    if depth > 4 || random__int 4 < depth then Vide
    else Noeud (random__int 100, make (depth+1), make (depth+1))
  in
  make 0;;


(** Exercice 1 *)

type arbre =
  | Vide
  | Noeud of int * arbre * arbre ;;

let rec hauteur = function
  | Vide -> 0
  | Noeud (_, l, r) -> 1 + max (hauteur l) (hauteur r)
;;

let rec chercher a x = match a with
  | Vide -> false
  | Noeud (y, l, r) ->
      x = y || chercher l x || chercher r x
;;

let rec taille a = match a with
  | Vide -> 0
  | Noeud (_, l, r) -> 1 + taille l + taille r
;;

let infixe a =
  let rec aux acc a = match a with
    | Vide -> acc
    | Noeud (x, l, r) ->
        let acc = aux acc r in
        aux (x :: acc) l
  in
  aux [] a
;;

let prefixe a =
  let rec aux acc a = match a with
    | Vide -> acc
    | Noeud (x, l, r) ->
        let acc = aux acc r in
        let acc = aux acc l in
        x :: acc
  in
  aux [] a
;;

(* on commence par implémenter les piles *)
type 'a stack == 'a list ref;;
exception EmptyStack;;
let stack_push l x = l := x :: !l ;;
let stack_pop l = match !l with
  | [] -> raise EmptyStack
  | x :: l' ->
      l := l';
      x
;;
let stack_create () = ref [] ;;
let stack_is_empty l = match !l with [] -> true | _::_ -> false;;
let stack_top l = match !l with [] -> raise EmptyStack | x::_ -> x;;

type exploration =
    | Renvoyer of int
    | Explorer of arbre ;;

(* implementation avec des listes *)
let infixe_egal a b =
  (* etiquette suivante dans le parcours infixe *)
  let rec next l = match l with
    | [] -> None
    | Renvoyer i :: l' -> Some (i, l')
    | Explorer (Vide) :: l' -> next l'
    | Explorer (Noeud (x, l, r)) :: l' ->
        next (Explorer l :: Renvoyer x :: Explorer r :: l')
  in
  let rec aux l1 l2 = match next l1, next l2 with
    | None, None -> true
    | Some _, None
    | None, Some _ -> false
    | Some (x,l1'), Some (y,l2') -> x=y && aux l1' l2'
  in
  aux [Explorer a] [Explorer b]
;;

(* change la forme de l'arbre a aléatoirement, sans changer
  son ordre de parcours infixe *)
let rec rebalancer a = match a with
  | Vide -> Vide
  | Noeud (x, Noeud (y, l', r'), r) when random__int 2 = 1 ->
      Noeud (y, rebalancer l', Noeud (x, rebalancer r', rebalancer r))
  | Noeud (x, l, Noeud (y, l', r')) when random__int 2 = 1 ->
      Noeud (y, Noeud (x, l, l'), r')
  | Noeud (x, l, r) -> Noeud (x, rebalancer l, rebalancer r)
;;

for i = 0 to 100 do
  let t = arbre_aleatoire () in
  let t' = rebalancer t in
  if infixe t <> infixe t' then failwith "erreur: rebalancer";
done;;

for i = 0 to 100 do
  let t = arbre_aleatoire () in
  let t' = rebalancer t in
  if not (infixe_egal t t') then failwith "erreur: infix_egal";
done;;

(* implementation avec des piles *)
let infixe_egal2 a b =
  (* initialiser deux piles, contenant chacune
    des sous-arbres à énumérer *)
  let s1 = stack_create () in
  let s2 = stack_create () in
  stack_push s1 (Explorer a);
  stack_push s2 (Explorer b);
  (* obtenir l'élément suivant dans le parcours
    infixe d'une pile d'exploration *)
  let rec next s =
    if stack_is_empty s then None
    else match stack_pop s with
      | Renvoyer i -> Some i
      | Explorer Vide -> next s
      | Explorer (Noeud (x, l, r)) ->
          (* attention à l'ordre ! *)
          stack_push s (Explorer r);
          stack_push s (Renvoyer x);
          stack_push s (Explorer l);
          next s
  in
  let rec aux () =
    match next s1, next s2 with
    | None, None -> true
    | Some _, None
    | None, Some _ -> false
    | Some x, Some y -> x=y && aux ()
  in aux ()
;;

for i = 0 to 100 do
  let t = arbre_aleatoire () in
  let t' = rebalancer t in
  if not (infixe_egal2 t t') then failwith "erreur: infix_egal2";
done;;


(** Exercice 2 *)

let ecrase p =
  while not (stack_is_empty p) do
    stack_pop p;
  done;;

let echange p =
  try
    let a = stack_pop p in
    let b = stack_pop p in
    stack_push p a;
    stack_push p b
  with EmptyStack -> ()
;;

let rotation p =
  if stack_is_empty p then ()
  else begin
    let p' = stack_create () in
    (* le sommet *)
    let a = stack_pop p in
    (* copier p dans p', à l'envers *)
    while not (stack_is_empty p) do
      stack_push p' (stack_pop p)
    done;
    stack_push p a;
    (* copier p' dans p  *)
    while not (stack_is_empty p') do
      stack_push p (stack_pop p')
    done;
  end
;;

let taille p =
  let p' = stack_create () in
  let n = ref 0 in
  (* copier et compter les éléments de p dans p' *)
  while not (stack_is_empty p) do
    stack_push p' (stack_pop p);
    incr n;
  done;
  (* copier les éléments de p' dans p *)
  while not (stack_is_empty p') do
    stack_push p (stack_pop p');
  done;
  !n
;;

let retourner p =
  let l = ref [] in
  while not (stack_is_empty p) do
    l := stack_pop p :: !l;
  done;
  let rec iter_list l = match l with
    | [] -> ()
    | x :: l' -> stack_push p x; iter_list l'
  in
  iter_list (rev !l)
;;

let copier p =
  let l = ref [] in
  while not (stack_is_empty p) do
    l := stack_pop p :: !l;
  done;
  (* créer une nouvelle pile et restaurer p *)
  let result = stack_create () in
  let rec iter l = match l with
    | [] -> result
    | x :: l' ->
        stack_push p x;
        stack_push result x;
        iter l'
  in
  iter !l
;;

(** Exercice 3 *)

type expr =
    | Const of int  (* constante *)
    | Plus of expr * expr (* x plus y *)
    | Fois of expr * expr (* x fois y *)
    | Moins of expr  (* -x *)
;;

type operation =
  | OpConst of int (* constante *)
  | OpPlus         (* addition *)
  | OpFois         (* multiplication *)
  | OpSoustraire   (* soustraction *)
;;

(* evalue la suite d'opérations avec une pile *)
let eval_pile l =
  let p = stack_create () in
  let rec eval l = match l with
    | [] -> stack_top p
    | op :: l' ->
        begin match op with
        | OpConst i -> stack_push p i
        | OpPlus ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (a+b)
        | OpFois ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (a*b)
        | OpSoustraire ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (b-a)
        end;
        eval l'
  in eval l
;;

let e = [OpConst 1; OpConst 2; OpPlus; OpConst 4; OpConst 2; OpSoustraire; OpPlus];;

eval_pile e = 5;;


let op2expr l =
  let p = stack_create () in
  let rec convert l = match l with
    | [] -> stack_top p
    | op :: l' ->
        begin match op with
        | OpConst i -> stack_push p (Const i)
        | OpPlus ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (Plus(a,b))
        | OpFois ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (Fois(a,b))
        | OpSoustraire ->
            let a = stack_pop p in
            let b = stack_pop p in
            stack_push p (Plus(b, Moins a))
        end;
        convert l'
  in convert l
;;

(* rappel: évaluation des expressions *)
let rec eval_expr = function
  | Const i -> i
  | Plus (a,b) -> eval_expr a + eval_expr b
  | Fois (a,b) -> eval_expr a * eval_expr b
  | Moins a -> - (eval_expr a);;

let eval l =
  eval_expr (op2expr l);;

(* (d): un parcours postfixe d'une expression donne une suite d'opérations *)
let expr2op e =
  let rec aux acc e = match e with
    | Const i -> OpConst i :: acc
    | Plus(a,b) ->
        let acc = OpPlus :: acc in
        let acc = aux acc b in
        aux acc a
    | Fois(a,b) ->
        let acc = OpFois :: acc in
        let acc = aux acc b in
        aux acc a
    | Moins a ->
        let acc = OpSoustraire :: acc in
        let acc = aux acc a in
        OpConst 0 :: acc
  in
  aux [] e;;

let expr_aleatoire () =
  let rec make depth =
    if depth > 4 then Const (random__int 41 - 20)
    else match random__int 4 with
    | 0 -> Const (random__int 41 - 20)
    | 1 -> Plus (make (depth+1), make (depth+1))
    | 2 -> Fois (make (depth+1), make (depth+1))
    | 3 -> Moins (make (depth+1))
    | _ -> failwith "impossible"
  in
  make 0;;

let rec afficher_expr e =
  match e with
  | Const i -> string_of_int i
  | Plus(a,b) -> "(" ^ afficher_expr a ^ " + " ^ afficher_expr b ^ ")"
  | Fois(a,b) -> "(" ^ afficher_expr a ^ " * " ^ afficher_expr b ^ ")"
  | Moins a -> "- " ^ afficher_expr a
;;

for i = 0 to 100 do
  let e = expr_aleatoire () in
  if eval_expr e <> eval (expr2op e)
    then failwith "echec de commutativité sur l'évaluation (1)";
  if eval_expr e <> eval_pile (expr2op e)
    then failwith "echec de commutativité sur l'évaluation (2)";
done;;