TD 3

(** TD 3 *)

(** Exercice 1 *)

let somme_liste : float list -> float  =
  fun l -> List.fold_right (+.) l 0.

let nb_occu : 'a list -> 'a -> int =
  fun l e ->
  List.fold_right
    (fun x y -> if x= e then x + y else y)
    l 0

let appartient : 'a list -> 'a -> bool =
  fun l e ->
  List.fold_right (fun x y -> x = e || y) l false

let ensemble  =
  fun l ->
  List.fold_right
    (fun x y -> if appartient y x then y else x::y)
    l []

let regroupe : 'a list -> ('a * int) list =
  fun l ->
  List.map (fun x -> (x, nb_occu l x)) (ensemble l)

let inclus : 'a list -> 'a list -> bool =
  fun l1 l2 ->
  List.fold_right
    (&&)
    (List.map (fun (x,y) -> y <= nb_occu l2 x) (regroupe l1))
    true

let liste_egal : 'a list -> 'a list -> bool =
  fun l1 l2 -> inclus l1 l2 && inclus l2 l1


(* Exercice 2 *)

(* Question 1 *)

let rec subst : 'a list -> 'a -> 'a -> 'a list =
  fun l a b ->
  match l with
    [] -> []
  | h::t when h = b -> a::(subst t a b)
  | h::t -> h::(subst t a b)

(* Question 2 *)

let listMin : 'a list -> 'a  =
  fun l ->
  let rec aux l d =
    match l with
      [] -> d
    | h::t -> min h (aux t d)
  in aux (List.tl l) (List.hd l)


(* Question 3 *)

let rec cut : 'a list -> int -> 'a list * 'a list =
  fun l n ->
  match l with
    [] -> ([], [])
  | h::t when n > 0 ->
     let (l1,l2) = cut t (n - 1) in
     (h::l1, l2)
  | h::t ->
     let (l1,l2) = cut t (n - 1) in
     (l1, h::t);;

let split : 'a list -> 'a list * 'a list =
  fun l -> cut l (List.length l / 2);;

(** Exercice 3 *)

let g = List.map (fun (x,y) -> (-x, y + 1))

(* List.map : ('a -> 'b) -> 'a list -> 'b list *)
(* fun (x,y) -> (-x, y +1) : int * int -> int * int *)
(* Les paramètres 'a et 'b de List.map sont donc instanciés par int * int *)
(* ce qui donne (int * int) list -> (int * int) list pour l'expression *)

let rec f = fun x y z ->
  match x with
    [] -> z
  | h::t -> y h (f t y z)

(* le type de f est de la forme 'a -> 'b -> 'c -> 'd *)
(* par le filtrage 'a est de la forme 'e list *)
(* par le premier cas du filtrage : 'c = 'd (le retour de f est z) *)
(* par l'application dans le second cas du filtrage : y : 'e -> 'd -> 'd *)
(* au final on a : f: 'e list -> ('e -> 'd -> 'd) -> 'd -> 'd *)

let l = List.map (fun p -> p 7) [(fun n m -> n + m)]

(* List.map : ('a -> 'b) -> 'a list -> 'b list) *)
(* fun p -> p 7 : (int -> 'c) -> 'c *)
(* fun n m -> n + m : (int -> int -> int) list *)
(* par application on a donc 'a -> 'b = (int -> 'c) -> 'c *)
(* et 'a list = (int -> int -> int) list *)
(* en simplifiant on obtient : 'a = int -> 'c, 'c = 'b et 'a = int -> int -> int *)
(* et donc 'a = int -> int -> int et 'b = int -> int *)
(* l est de type (int -> int) list *)

let f = fun l -> List.map (fun (g,x) -> (g x) + 1) l


(* fun (g,x) -> (g x) + 1 : ('a * 'b) -> 'c *)
(* par le type de + on a
   - (g x) : int et donc g : 'b -> int puisque x:'b
   - 'c = int *)
(* ce qui donne fun (g,x) : ('b -> int, int) -> int *)
(* List.map : ('c -> 'd) -> 'c list -> 'd list *)
(* par application on a 'c -> 'd = ('b -> int, int) -> int *)
(* et donc 'c = 'b -> int, int et 'd = int *)
(* le type de l'expression est donc ('b -> int, int) list -> int list *)

let b = fun l ->
  let f =
    fun l ->
      match l with
        [] -> []
      | h::_ -> h
  in List.rev (List.map f l)

(* b est une fonction donc b : 'a -> 'b *)
(* *)
(* f est une fonction et donc f : 'c -> 'd *)
(* par le filtrage, l est une liste et donc 'c = 'e list *)
(* par le résultat du premier cas, la valeur de retour est une liste et donc
   'd = 'f list *)
(* par le résultat du second cas 'e = 'f list et donc f : ' f list list -> 'f list *)
(* List.map : ('g -> 'h) -> 'g list -> 'h list *)
(* par application, on a 'g = 'f list list et 'h = 'f list ce qui donne
   List.map f : 'f list list list -> 'f list list *)
(* on a donc 'a = 'f list list list et 'b = 'f list list (rev ne change pas le type) *)

(** Exercice 4 *)

(* Pour le plaisir, on commence par réécrire les fonctions avec du filtrage
   et la fonctoin List.fold_right *)

let rec insert : 'a -> 'a list -> 'a list =
  fun x l ->
  match l with
    [] -> [x]
  | h::t when x < h -> x::l
  | h::t -> h::(insert x t)

let rec tri_insertion : 'a list -> 'a list =
  fun l -> List.fold_right insert l []

(* Pour généraliser ces fonctions, on prend simplement la relation
   d'ordre en paramètre *)

let rec insert order =
  fun x l ->
  match l with
    [] -> [x]
  | h::t when order x h -> x::l
  | h::t -> h::(insert order x t)

let rec tri_insertion order =
  fun l -> List.fold_right (insert order) l []

(* On retrouve le cas de base en utilisant la relation d'ordre usuelle sur les entiers *)

let exemple1 = tri_insertion (<)

(* On peut facilement inverser la relation en écrivant *)

let exemple2 = tri_insertion (>)

(* En supposant qu'un monôme est représenté par une paire (c,d) ou c est le
   coefficient et d le degré du monôme *)

let exemple3 = tri_insertion (fun (x,y) (z,t) -> x < z)

(* Exercice 5 *)

let rec alterne : 'a list -> bool =
  fun l ->
  match l with
    []
  | [_] -> true
  | [h1;h2] -> h1 <> h2
  | h1::h2::h3::t when h1 < h2 && h2 > h3 -> alterne (h2::h3::t)
  | h1::h2::h3::t when h1 > h2 && h2 > h3 -> alterne (h2::h3::t)
  | _ -> false

(* Exercice 6 *)

let rec schuffle : 'a list -> 'a list -> 'a list list =
  fun l1 l2 ->
  match (l1, l2) with
    (x, []) | ([], x) -> [x]
  | (h1::t1, h2::t2) ->
     List.map (fun x -> h1::x) (schuffle t1 l2)
     @ List.map (fun x -> h2::x) (schuffle l1 t2)