(* ==============================================
   Types algebriques et filtrage (match)
   ============================================== *)

(* Operateur pipe (discute precedemment) *)
let (|>) x f = f x

(* ==============================================
   1. Entiers de Peano
   ============================================== *)

type nat = Zero | Succ of nat

(* Traduction nat -> int *)
let rec to_int n = match n with
  | Zero -> 0
  | Succ n -> 1 + to_int n

(* Addition *)
let rec add a b = match a with
  | Zero -> b
  | Succ n -> Succ (add n b)

(* Multiplication *)
let rec mul a b = match a with
  | Zero -> Zero
  | Succ n -> add b (mul n b)

(* Factorielle en Peano *)
let rec fact n = match n with
  | Zero -> Succ Zero       (* 0! = 1 *)
  | Succ n -> mul (Succ n) (fact n)

let () =
  let trois = Succ (Succ (Succ Zero)) in
  let quatre = Succ trois in
  Printf.printf "3 + 4 = %d\n" (to_int (add trois quatre));
  Printf.printf "3 * 4 = %d\n" (to_int (mul trois quatre));
  Printf.printf "4!     = %d\n" (to_int (fact quatre))

(* ==============================================
   2. Listes polymorphes (re-inventees)
   ============================================== *)

type 'a lst = Nil | Cons of 'a * 'a lst

(* Longueur *)
let rec longueur l = match l with
  | Nil -> 0
  | Cons (_, xs) -> 1 + longueur xs

(* Concatener deux listes *)
let rec concat l1 l2 = match l1 with
  | Nil -> l2
  | Cons (x, xs) -> Cons (x, concat xs l2)

(* Map *)
let rec map f l = match l with
  | Nil -> Nil
  | Cons (x, xs) -> Cons (f x, map f xs)

(* Filter *)
let rec filter p l = match l with
  | Nil -> Nil
  | Cons (x, xs) ->
    if p x then Cons (x, filter p xs)
    else filter p xs

(* Conversion vers la liste standard *)
let rec to_list l = match l with
  | Nil -> []
  | Cons (x, xs) -> x :: to_list xs

let () =
  let l = Cons (1, Cons (2, Cons (3, Cons (4, Cons (5, Nil))))) in
  Printf.printf "longueur [1..5] = %d\n" (longueur l);
  Printf.printf "map (x->x*x) [1..5] = [%s]\n"
    (String.concat "; " (List.map string_of_int
      (to_list (map (fun x -> x * x) l))));
  Printf.printf "filter pair [1..5] = [%s]\n"
    (String.concat "; " (List.map string_of_int
      (to_list (filter (fun x -> x mod 2 = 0) l))))

(* ==============================================
   2-bis. Dictionnaire a partir des listes
   ============================================== *)

type ('k, 'v) dico = ('k * 'v) lst

(* Dictionnaire vide *)
let dico_vide : ('k, 'v) dico = Nil

(* Ajouter une association (ecrase l'ancienne si la cle existe) *)
let dico_ajoute k v d = Cons ((k, v), d)

(* Chercher une cle : retourne None si absente *)
let rec dico_cherche k d = match d with
  | Nil -> None
  | Cons ((k', v), suite) ->
    if k = k' then Some v
    else dico_cherche k suite

(* Supprimer une cle (premiere occurrence) *)
let rec dico_supprime k d = match d with
  | Nil -> Nil
  | Cons ((k', v), suite) ->
    if k = k' then suite
    else Cons ((k', v), dico_supprime k suite)

(* Conversion vers liste standard *)
let dico_to_list d = to_list d

let () =
  (* Construction par flot de donnees *)
  let d = dico_vide
    |> dico_ajoute "x" 10
    |> dico_ajoute "y" 20
    |> dico_ajoute "z" 30 in
  Printf.printf "cherche 'x' = %s\n"
    (match dico_cherche "x" d with
     | Some n -> string_of_int n
     | None -> "introuvable");
  Printf.printf "cherche 'w' = %s\n"
    (match dico_cherche "w" d with
     | Some n -> string_of_int n
     | None -> "introuvable");
  let d2 = dico_supprime "y" d in
  Printf.printf "apres suppression de 'y' :\n";
  let rec affiche_dico d = match d with
    | Nil -> ()
    | Cons ((k, v), suite) ->
      Printf.printf "  %s -> %d\n" k v;
      affiche_dico suite
  in
  affiche_dico d2

(* ==============================================
   3. Arbres binaires
   ============================================== *)

type 'a tree = Leaf | Node of 'a * 'a tree * 'a tree

(* Hauteur *)
let rec hauteur t = match t with
  | Leaf -> 0
  | Node (_, g, d) -> 1 + max (hauteur g) (hauteur d)

(* Map sur un arbre *)
let rec map_tree f t = match t with
  | Leaf -> Leaf
  | Node (x, g, d) -> Node (f x, map_tree f g, map_tree f d)

(* Parcours infixe : [gauche; racine; droite] *)
let rec to_list_tree t = match t with
  | Leaf -> []
  | Node (x, g, d) -> to_list_tree g @ [x] @ to_list_tree d

let () =
  let t = Node (5,
            Node (3, Leaf, Leaf),
            Node (7, Node (6, Leaf, Leaf), Leaf)) in
  Printf.printf "hauteur = %d\n" (hauteur t);
  Printf.printf "infixe   = [%s]\n"
    (String.concat "; " (List.map string_of_int (to_list_tree t)));
  let double_t = map_tree (fun x -> 2 * x) t in
  Printf.printf "double   = [%s]\n"
    (String.concat "; " (List.map string_of_int (to_list_tree double_t)))

(* ==============================================
   4. Arbres syntaxiques (AST)
   ============================================== *)

type expr =
  | Int of int
  | Add of expr * expr
  | Sub of expr * expr
  | Mul of expr * expr

(* Evaluer une expression *)
let rec eval e = match e with
  | Int n -> n
  | Add (a, b) -> eval a + eval b
  | Sub (a, b) -> eval a - eval b
  | Mul (a, b) -> eval a * eval b

(* Afficher une expression parenthsee *)
let rec show e = match e with
  | Int n -> string_of_int n
  | Add (a, b) -> "(" ^ show a ^ " + " ^ show b ^ ")"
  | Sub (a, b) -> "(" ^ show a ^ " - " ^ show b ^ ")"
  | Mul (a, b) -> "(" ^ show a ^ " * " ^ show b ^ ")"

(* Deriver formellement par rapport a x *)
let rec derive e = match e with
  | Int _ -> Int 0
  | Add (a, b) -> Add (derive a, derive b)
  | Sub (a, b) -> Sub (derive a, derive b)
  | Mul (a, b) -> Add (Mul (derive a, b), Mul (a, derive b))
  (* d/dx (a*b) = a'*b + a*b' *)

(* Compter le nombre d'operations *)
let rec profondeur e = match e with
  | Int _ -> 0
  | Add (a, b) | Sub (a, b) | Mul (a, b) -> 1 + max (profondeur a) (profondeur b)

let () =
  (* (3 + 4) * (10 - 2) *)
  let e = Mul (Add (Int 3, Int 4), Sub (Int 10, Int 2)) in
  Printf.printf "expr    = %s\n" (show e);
  Printf.printf "eval    = %d\n" (eval e);
  Printf.printf "derive  = %s\n" (show (derive e));
  Printf.printf "derive(eval) = %d\n" (eval (derive e));
  Printf.printf "profondeur = %d\n" (profondeur e);

  (* 3*x^2 + 2*x + 1 represente avec x = Int 5 *)
  (* On ne peut pas representer x simplement ici,
     on ajoute un constructeur Var *)
  ()

(* On ajoute Var pour representer les variables *)
type expr_var =
  | Int of int
  | Var of string
  | Add of expr_var * expr_var
  | Sub of expr_var * expr_var
  | Mul of expr_var * expr_var

let rec eval_var env e = match e with
  | Int n -> Some n
  | Var x -> dico_cherche x env
  | Add (a, b) ->
    (match eval_var env a, eval_var env b with
     | Some va, Some vb -> Some (va + vb)
     | _ -> None)
  | Sub (a, b) ->
    (match eval_var env a, eval_var env b with
     | Some va, Some vb -> Some (va - vb)
     | _ -> None)
  | Mul (a, b) ->
    (match eval_var env a, eval_var env b with
     | Some va, Some vb -> Some (va * vb)
     | _ -> None)

let rec show_var e = match e with
  | Int n -> string_of_int n
  | Var x -> x
  | Add (a, b) -> "(" ^ show_var a ^ " + " ^ show_var b ^ ")"
  | Sub (a, b) -> "(" ^ show_var a ^ " - " ^ show_var b ^ ")"
  | Mul (a, b) -> "(" ^ show_var a ^ " * " ^ show_var b ^ ")"

(* Derivee formelle avec variables *)
let rec derive_var v e = match e with
  | Int _ -> Int 0
  | Var x when x = v -> Int 1
  | Var _ -> Int 0
  | Add (a, b) -> Add (derive_var v a, derive_var v b)
  | Sub (a, b) -> Sub (derive_var v a, derive_var v b)
  | Mul (a, b) -> Add (Mul (derive_var v a, b), Mul (a, derive_var v b))

let () =
  (* Representer 3*x^2 + 2*x + 1 :
     x^2 avec Mul (Var "x", Var "x")
     3*x^2 avec Mul (Int 3, ...)
     etc.
  *)
  let env = dico_ajoute "x" 5 dico_vide in
  let x = Var "x" in
  let x2 = Mul (x, x) in
  let p = Add (Add (Mul (Int 3, x2), Mul (Int 2, x)), Int 1) in
  Printf.printf "P(x)     = %s\n" (show_var p);
  (match eval_var env p with
   | Some n -> Printf.printf "P(5)     = %d\n" n
   | None -> Printf.printf "P(5)     = erreur\n");
  let d = derive_var "x" p in
  Printf.printf "P'(x)    = %s\n" (show_var d);
  (match eval_var env d with
   | Some n -> Printf.printf "P'(5)    = %d\n" n
   | None -> Printf.printf "P'(5)    = erreur\n")