# CorrectionDM2021

## Exo1

(* Q 1.1 *)

let x z y =
  let x = 
    let z = 
      y - z in (* 1, 1 *)
    let x z y = 
      z - y in (* 5, 5 *)
    x y z in  (* 5, 1, 3 *)
  x + y (* 2, 1 *)

(* b) x y z --> z + y *)
  
(* Q 1.2 *)  
(*
let plus_moins x y =
let g = fun u -> - u in
match x with
| 0 -> g 0 + y
| x -> g 0 + g y - x *)

let plus_moins_plus x y =
let g = fun u -> - u in
match x with
| 0 -> (g 0) + y
| x -> g (0 + (g y) - x)

let plus_moins_moins x y =
let g = fun u -> - u in
match x with
| 0 -> g (0 + y)
| x -> (g 0) + g (y - x)

(* Q 1.3 *)

exception E
     
let f y l =
  let rec h = fun l ->
    match l with
    | [] -> raise E
    | x :: [] -> (x, [y])
    | x :: l' -> let g = h l' in
                 let s = min (fst g) x in
                 (fst g, s :: (snd g))
  in
  snd (h l)

(*
a)

l		| g		| s		 | h l
[4]		  X		  X		   (4, [9])
[3;4]		  (4, [9])	  3		   (4, [3;9])		
[7;3;4]  	  (4, [3;9])      4  		   (4; [4;3;9])
[1;7;3;4] 	  (4, [4;3;9])    1 	 	   (4; [1;4;3;9])
[5;1;7;3;4]	  (4, [1;4;3;9])  4		   (4, [4;1;4;3;9])

f 9 [5;1;7;3;4] --> [4;1;4;3;9]

b) f y l remplace chaque element de la liste par le min entre lui et le dernier element, sauf pour le dernier élément en question, qui est remplacé par y

 *)    

## Exo2

(* Question 1 *)

let f1 x (y, z) = match x with
  | 0 -> y = z
  | _ -> fst y
;;

(* On effectue un filtrage sur x dont un des cas est 0, ce qui signifie qu'on compare x à 0, et donc qu'il doit être un entier.
   La fonction = prend deux arguments de même type et renvoie un booléen, donc y et z sont de même type, et le type de retour de f1 est un booléen.
   On applique la fonction fst à y, c'est donc une paire. De plus, comme fst y peut être la valeur de retour de f1, et que le type de retour de f1 est un booléen, on a que le premier élément de y est forcément un booléen.
   On n'a pas d'information particulière sur le deuxième élément de la paire y, il est donc d'un type générique 'a, et y est de type bool * 'a (attention: on utilise l'astérisque pour le type d'une paire, et pas la notation (bool, 'a)).
   Comme on a déjà vu que le type de z est le même que celui de y, on obtient un type global
      f1 : int -> ((bool * 'a) * (bool * 'a)) -> bool *)

let f2 x y = if x then [x]::y else  [];;

(* Comme x est utilisé comme condition du if, x est un booléen.
   L'expression [x]::y nous indique que y est une liste d'éléments chacun du même type que [x] (et non pas x, car :: correspond à l'ajout dans une liste, pas à une concaténation !), donc y est une liste de listes de booléens.
   La fonction f2 renvoie des objets du type de [x]::y, c'est-à-dire également des listes de listes de booléens.
   On obtient donc un type global
      f2 : bool -> bool list list -> bool list list *)



(* Question 2 *)

(* La curryfication est ce qui se passe quand on applique une fonction à n paramètres seulement à ses k premiers paramètres (avec k<n). Au lieu de renvoyer un objet de son type de retour, elle renvoie alors une fonction prenant n-k paramètres et avec le même type de retour que la fonction originale.
   La curryfication permet d'écrire des codes plus concis, et d'éviter des formulations redondantes du type "fun y -> f x y" (qui peut être remplacé par "f x" pour f une fonction à 2 paramètres).
   Néanmoins, si on veut pouvoir l'utiliser, il est important de considérer l'ordre des paramètres : "fun x -> f x y" ne peut pas être raccourci par curryfication, puisque l'application partielle de f ne peut se faire que sur les k premiers paramètres. *)
   
let not_list = List.map not;;

(* Ici, on applique la curryfication à la fonction List.map, qui prend habituellement deux paramètres : une fonction de type 'a -> 'b et une liste d'éléments de type 'a (avec 'a = 'b = bool dans notre cas).
   On pourrait écrire
      let not_list l = List.map not l;;
   mais c'est redondant.
   C'est vrai uniquement parce que la seule occurrence de la variable l après le signe = est à la toute fin de la définition de la fonction. *)
   
   

(* Question 3 *)

type 'a arbre_binaire =
    Feuille
  | Noeud of'a *'a arbre_binaire *'a arbre_binaire ;;
  
let rec iter_arbre a f = match a with
  | Feuille -> ()
  | Noeud (x, ag, ad) -> f x; iter_arbre ag f; iter_arbre ad f ;;
  
(* Type : 'a arbre_binaire -> ('a -> unit) -> unit.
   Attention : le sujet demandait bien à ce que f renvoit le type unit, c'est-à-dire qu'elle n'effectue que des effets de bord (pensez à des fonctions comme "print_int"). La fonction iter_arbre ne doit donc pas renvoyer un arbre, comme le ferait une hypothétique fonction map_arbre, par exemple.
   On remarque au passage que le parcours effectué par cette fonction est un parcours préfixe, mais on pourrait le transformer en parcours infixe ou suffixe en changeant la position de "f x" dans la troisème ligne. *)
  
let rec compte_arbre a p = match a with
  | Feuille -> 0
  | Noeud (x, ag, ad) -> let cpt = (compte_arbre ag p) + (compte_arbre ad p) in
                         if p x then cpt + 1
                                else cpt;;
                                
(* Type : 'a arbre_binaire -> ('a -> bool) -> int.
   On compte les noeuds de a qui contiennent une valeur x telle que p x = true. Attention à bien renvoyer 0 pour les feuilles (et pas "f Feuille" ou "()" qui n'ont pas le bon type).
   Remarque : maintenant que nous avons vu les références en cours, on pourrait utiliser iter_arbre et une référence de la façon suivante pour obtenir exactement le même résultat. *)
      
let compte_arbre_ref a p =
   let cpt = ref 0 in
   iter_arbre a (fun x -> if p x then cpt := !cpt + 1);
   !cpt;;

## Exo3

let flatten l = List.fold_right (@) l [];; (* 5*)
let flatten2 l = List.fold_left (@) [] l;;

let sumcompose2 f x k =
  let rec sumaux x k l' s  = 
    if k = 0 then l' else 
      let s' = (s + f x) in sumaux (f x) (k - 1) (s' :: l') s' 
  in List.rev (sumaux x k  [x] x);;

 let sumcompose = sumcompose2 ;; 

(* type de surcompose : (int -> int) -> int -> int -> int list
- n représente un nombre de fois où on applique f, donc n : int
- On additionne x et f x avec + (et pas +.) donc x, f x : int
donc f : int -> int et surcompose renvoie une liste d'entiers
 *)

Printf.printf "TESTS CORRECTION";;
flatten [[1 ; 1; 2]; [3 ; 5]; [8 ; 13; 21]];;
flatten2 [[1 ; 1; 2]; [3 ; 5]; [8 ; 13; 21]];;
Printf.printf "expected: [1 ; 1 ; 3 ; 5 ; 8 ; 13 ; 21 ]" ;;
sumcompose (fun x -> x * x) 2 3 ;;
sumcompose2 (fun x -> x * x) 2 3 ;;
Printf.printf "expected [2 ; 6 ; 22 ; 278]";;

## Exo4

(*Question 4.1*)
type op =
  | Add | Sub | Mul | Div 

type arbre = 
  |Feuille of int
  |Noeud of op*arbre*arbre

(*Question 4.2*)
(* (1 + 2) + 3 *)
let e1 = Noeud(Add, Noeud(Add, Feuille(1), Feuille(2)), Feuille(3))
(* (12 × 7) − ((2/4) + 7) *)
let e2 = Noeud(Sub, Noeud(Mul, Feuille(12), Feuille(7)), Noeud(Add, Noeud(Div, Feuille(2), Feuille(4)), Feuille(7)))
(* (((3 × 4) + ((18/3) × 4)) + (10 + 4)) − 8 *)
let e3 = Noeud(Sub, Noeud (Add, (Noeud(Add, Noeud(Mul, Feuille(3), Feuille(4)), Noeud(Mul, Noeud(Div, Feuille(18), Feuille(3)), Feuille(4)))), Noeud (Add, Feuille(10), Feuille(4))), Feuille(8))

(*Question 4.3*)
let rec to_string a = 
  match a with
    Feuille(x) -> string_of_int x 
  |Noeud(Add, a1, a2) -> "(" ^ (to_string a1) ^ " + " ^ (to_string a2) ^ ")"
  |Noeud(Sub, a1, a2) -> "(" ^ (to_string a1) ^ " - " ^ (to_string a2) ^ ")"
  |Noeud(Mul, a1, a2) -> "(" ^ (to_string a1) ^ " x " ^ (to_string a2) ^ ")"
  |Noeud(Div, a1, a2) -> "(" ^ (to_string a1) ^ " / " ^ (to_string a2) ^ ")"

let print_tree a = 
    Printf.printf("%s\n") (to_string a)

(*Question 4.4*)
let rec eval a =
    match a with 
    Feuille(x) -> x
    |Noeud(Add, a1, a2) -> eval(a1) + eval (a2)
    |Noeud(Sub, a1, a2) -> eval(a1) - eval (a2)
    |Noeud(Mul, a1, a2) -> eval(a1) * eval (a2)
    |Noeud(Div, a1, a2) -> let y = eval a2 in 
                           if a2 = 0 
                           then failwith "Div par 0"
                           else eval(a1) / y
    
(*Question 4.5*) 
 let rec check3 a =
     match a with 
     Feuille(x) -> x=0 || x=1 || x=2
     |Noeud(Add, a1, a2) -> (check3 a1) && (check3 a2)
     |Noeud(Mul, a1, a2) -> (check3 a1) && (check3 a2)
     |Noeud(_) -> false

(*Question 4.6*) 
let rec eval3 a =
  match a with 
    Feuille(x) -> x mod 3
  |Noeud(Add, a1, a2) -> (eval3 a1 + eval3 a2) mod 3
  |Noeud(Mul, a1, a2) -> (eval3 a1 * eval3 a2) mod 3
  |Noeud(_) -> failwith "erreur operation"


(*Question 4.7*) 
let rec aux_2 l e =
  match l with
  |[]-> [e]
  |x::ll -> Noeud(Add, e, x)::Noeud(Mul, e, x)::(aux_2 ll e)
  
let rec aux_1 l1 l2 = 
  match l1 with 
  | [] -> []
  | e::ll -> (aux_2 l2 e)@(aux_1 ll l2)

let rec tree_of_height_n n = 
  match n with 
  |0 -> []
  |1 -> [Feuille(0); Feuille(1); Feuille(2)]
  |n -> let a = (tree_of_height_n (n-1)) in aux_1 a a


(*Question 4.8*) 
let genere_arbres n k =
    let n = tree_of_height_n n in
    List.filter (fun x -> eval3 x = k) n

## Exo5

(* Question 1 *)

let rec is_perm l1 l2 =
    (compare (List.sort compare l1) (List.sort compare l2)) = 0
;;

is_perm [2; 3; 4; 3] [3; 3; 4; 2] ;; (* true *)
is_perm [2; 3; 4; 3] [3; 4; 4; 2] ;; (* false *)
is_perm [2; 3; 4; 3] [2; 4; 3] ;; (* false *)

(* Question 2 *)

type tree =
    | Leaf of int
    | Sum of tree list
    | Product of tree list
;;

let t1 = Sum [
    Product [
        Leaf 1;
        Product [
            Product [
                Leaf 2;
                Leaf 3
            ];
            Leaf 4
        ]
    ];
    Leaf 5;
    Product [
        Sum [
            Leaf 6;
            Leaf 7
        ];
        Leaf 8;
        Leaf 9
    ]
] ;;

let t2 = Sum [
    Product [
        Leaf 9;
        Sum [
            Leaf 7;
            Leaf 6
        ];
        Leaf 8
    ];
    Product [
        Product [
            Leaf 2;
            Leaf 4;
            Leaf 3
        ];
        Leaf 1;
    ];
    Leaf 5
] ;;

(* Simplifier un arbre et trier ses noeuds.
 * L'application de cette fonction sur deux arbres
 * equivalents donne le meme arbre, qui est
 * equivalent aux deux arbres.
 * L'application de cette fonction sur deux
 * arbres non equivalents ne donne pas le meme arbre.
 *)
let reduce t =
    let rec reduce_sum tl =
        List.sort compare
            (List.fold_left (fun acc t ->
                match t with
                | Leaf (v) -> (Leaf v) :: acc
                | Sum (tl) -> List.rev_append (reduce_sum tl) acc
                | Product (tl) -> (Product (reduce_product tl)) :: acc
            ) [] tl)
    and reduce_product tl =
        List.sort compare
            (List.fold_left (fun acc t ->
                match t with
                | Leaf (v) -> (Leaf v) :: acc
                | Sum (tl) -> (Sum (reduce_sum tl)) :: acc
                | Product (tl) -> List.rev_append (reduce_product tl) acc
            ) [] tl)
    in match t with
    | Leaf (v) -> Leaf v
    | Sum (tl) -> Sum (reduce_sum tl)
    | Product (tl) -> Product (reduce_product tl)
;;

let equivalent t1 t2 =
    (compare (reduce t1) (reduce t2)) = 0
;;



equivalent t1 t2 ;; (* true *)

equivalent
    (* (4+((7*6)+2+(4+5))+3) *)
    (Sum [Leaf 4; Sum [Product [Leaf 6; Leaf 7]; Leaf 2; Sum [Leaf 1; Leaf 5]]; Leaf 3])
    (* (1+2+3+4+5+(6*7)) *)
    (Sum [Leaf 1; Leaf 2; Leaf 3; Leaf 4; Leaf 5; Product [Leaf 6; Leaf 7]])
;; (* true *)

equivalent
    (* (1+(2*(3+4))+5) *)
    (Sum [Leaf 1; Product [Leaf 2; Sum [Leaf 3; Leaf 4]]; Leaf 5])
    (* (1+(2+(3+4))+5) *)
    (Sum [Leaf 1; Sum [Leaf 2; Sum [Leaf 3; Leaf 4]]; Leaf 5])
;; (* false *)

equivalent
    (Sum [Leaf 1])
    (Sum [Leaf 2])
;; (* false *)

equivalent
    (* (1+2+3) *)
    (Sum [Leaf 1; Leaf 2; Leaf 3])
    (* (2*3) *)
    (Product [Leaf 2; Leaf 3])
;; (* false *)

equivalent
    (* (1+2+3) *)
    (Sum [Leaf 1; Leaf 2; Leaf 3])
    (* (1*2*3) *)
    (Product [Leaf 1; Leaf 2; Leaf 3])
;; (* false *)