TP-programmation-fonctionnelle/TP2/tp2.ml

(******* TRIS ******)

(*  Tri par insertion **)

(*CONTRAT
Fonction qui ajoute un élément dans une liste triée, selon un ordre donné
Type : ('a->'a->bool)->'a->'a list -> 'a list
Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
Paramètre : elt, l'élement à ajouter
Paramètre : l, la liste triée dans laquelle ajouter elt
Résultat : une liste triée avec les éléments de l, plus elt
*)

let rec insert ordre elt l =
  match l with
  | [] -> [elt]
  | t::q ->
    if ordre elt t then
      elt::l
    else
      t::(insert ordre elt q)

(* TESTS *)
let%test _ = insert (fun x y -> x<y) 3 []=[3]
let%test _ = insert (fun x y -> x<y) 3 [2;4;5]=[2;3;4;5]
let%test _ = insert (fun x y -> x > y) 6 [3;2;1]=[6;3;2;1]


(*CONTRAT
Fonction qui trie une liste, selon un ordre donné
Type : ('a->'a->bool)->'a list -> 'a list
Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
Paramètre : l, la liste à trier
Résultat : une liste triée avec les éléments de l
*)

let tri_insertion ordre l =
  (* List.fold_right (fun e res_q -> insert ordre e res_q) l [] *)
  List.fold_right (insert ordre) l []

(* TESTS *)
let%test _ = tri_insertion (fun x y -> x<y) [] = []
let%test _ = tri_insertion (fun x y -> x<y) [4;2;4;3;1] = [1;2;3;4;4]
let%test _ = tri_insertion (fun x y -> x > y) [4;7;2;4;1;2;2;7] = [7;7;4;4;2;2;2;1]


(*  Tri fusion **)

(* CONTRAT
Fonction qui décompose une liste en deux listes de tailles égales à plus ou moins un élément
Paramètre : l, la liste à couper en deux
Retour : deux listes
*)

let rec scinde l =
  match l with
  | [] -> ([],[])
  | t::[] -> ([t],[])
  | t1::t2::q -> let (la, lb) = scinde q in
    (t1::la, t2::lb)
    

(* TESTS *)
(* Peuvent être modifiés selon l'algorithme choisi *)
let%test _ = scinde [1;2;3;4] = ([1;3],[2;4])
let%test _ = scinde [1;2;3] = ([1;3],[2])
let%test _ = scinde [1] = ([1],[])
let%test _ = scinde [] = ([],[])


(* Fusionne deux listes triées pour en faire une seule triée
Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
Paramètre : l1 et l2, les deux listes triées
Résultat : une liste triée avec les éléments de l1 et l2
*)

let rec fusionne ordre l1 l2 =
  match (l1,l2) with
  | (_,[]) -> l1
  | ([],_) -> l2
  | (t1::q1, t2::q2) ->
    if ordre t1 t2 then
      t1::(fusionne ordre q1 l2)
    else
      t2::(fusionne ordre l1 q2)


(*TESTS*)
let%test _ = fusionne (fun x y -> x<y) [1;2;4;5;6] [3;4] = [1;2;3;4;4;5;6]
let%test _ = fusionne (fun x y -> x<y) [1;2;4] [3;4] = [1;2;3;4;4]
let%test _ = fusionne (fun x y -> x<y) [1;2;4] [3;4;8;9;10] = [1;2;3;4;4;8;9;10]
let%test _ = fusionne (fun x y -> x<y) [] [] = []
let%test _ = fusionne (fun x y -> x<y) [1] [] = [1]
let%test _ = fusionne (fun x y -> x<y) [] [1] = [1]
let%test _ = fusionne (fun x y -> x<y) [1] [2] = [1;2]
let%test _ = fusionne (fun x y -> x>y) [1] [2] = [2;1]


(* CONTRAT
Fonction qui trie une liste, selon un ordre donné
Type : ('a->'a->bool)->'a list -> 'a list
Paramètre : ordre  ('a->'a->bool), un ordre sur les éléments de la liste
Paramètre : l, la liste à trier
Résultat : une liste triée avec les éléments de l
*)

let rec tri_fusion ordre l =
  match l with
  | [] -> []
  | [t] -> [t]
  | _ -> let (la,lb) = scinde l in
    fusionne ordre (tri_fusion ordre la) (tri_fusion ordre lb)


(* TESTS *)
let%test _ = tri_fusion (fun x y -> x<y) [] =[]
let%test _ = tri_fusion (fun x y -> x<y) [4;2;4;3;1] =[1;2;3;4;4]
let%test _ = tri_fusion (fun x y -> x > y) [4;7;2;4;1;2;2;7]=[7;7;4;4;2;2;2;1]


(*  Parsing du fichier *)
open Lexing

(* Affiche un quadruplet composé 
- du sexe des personnes ayant reçu ce prénom : 1 pour les hommes, 2 pour les femmes
- du prénom
- de l'année
- du nombre de fois où ce prénom a été donné cette année là
*)
let print_stat (sexe,nom,annee,nb) =
  Printf.eprintf "%s,%s,%d,%d%!\n" (if (sexe=1) then "M" else "F") nom annee nb

(* Analyse le fichier nat2016.txt (stratistique des prénoms entre 1900 et 2016) 
 et construit une liste de quadruplet (sexe,prénom,année,nombre d'affectation)
*)
let listStat = 
  (*let input = open_in "/mnt/n7fs/ens/tp_guivarch/pf/nat2016.txt" in *)
  let input =  open_in "nat2016.txt" in
  let filebuf = Lexing.from_channel input in
  Parser.main Lexer.token filebuf
  

(* Analyse le fichier nathomme2016.txt (stratistique des prénoms d'homme commençant par un A ou un B entre 1900 et 2016) 
 et construit une liste de quadruplets (sexe,prénom,année,nombre d'affectations)
*)
let listStatHomme = 
  (* let input = open_in "/mnt/n7fs/ens/tp_guivarch/pf/nathomme2016.txt" in *)
  let input =  open_in "nathomme2016.txt" in
  let filebuf = Lexing.from_channel input in
  Parser.main Lexer.token filebuf

(*  Les contrats et les tests des fonctions suivantes sont à écrire *)

let stat_insert l = tri_insertion (fun (_,_,_,nb_a) (_,_,_,nb_b) -> nb_a < nb_b) l
let stat_fusion l = tri_fusion (fun (_,_,_,nb_a) (_,_,_,nb_b) -> nb_a < nb_b) l

let tests_sorts l = 
  let t0 = Sys.time() in
  let list_insert_sorted = stat_insert l in
  let t1 = Sys.time() in
  let list_fusion_sorted = stat_fusion l in
  let t2 = Sys.time() in
  (t1 -. t0,t2 -. t1)