Programmation Fonctionnelle, Examen

Version & licenses
Creative Commons License

Programmation Fonctionnelle, Examen

Guyslain Naves

Exercice 1 : Manipulations de listes (4 points)

Implémenter les 4 fonctions suivantes : sum_list, reverse_even_length, pairing, int_map_of_list. Vous pouvez utiliser les fonctions de la librairie standard si vous le voulez.

Indice : pour int_map_of_list, vous pouvez utiliser List.mapi.

  1. (* Somme deux-à-deux les éléments de deux listes d'entiers de même longueur *)
  2. val sum_list : int list -> int list -> int list = <fun>
  3. (* Exemple : sum_list [1;2;3] [5;6;7] = [6; 8; 10] *)

  4. (* Renverse les listes de longueurs paires d'une liste,
  5. laisse les autres listes inchangées *)
  6. val reverse_even_length : 'a list list -> 'a list list = <fun>
  7. (* Exemple :
  8. reverse_even_length [[1;2];[3;4;5];[6;7;8;9]] = [[2;1];[3;4;5];[9;8;7;6]]
  9. *)

  10. (* Somme les paires d'éléments consécutifs d'une liste *)
  11. val pairing : int list -> int list = <fun>
  12. (* Exemple : pairing [1;2;3;4;1;3;5;6;7] = [3;5;7;5;4;8;11;13] *)

  13. module Int = struct type t = int let compare a b = a - b end
  14. module IMap = Map.Make(Int)
  15. (* [int_map_of_list list] crée une structure associant à chaque entier [pos]
  16. entre [0] et [List.length list - 1], l'élément en position [pos] dans [list].
  17. *)
  18. val int_map_of_list : 'a list -> 'a IMap.t
  19. (* Exemple : *)
  20. let map = int_map_of_list ["salade";"brebis";"loup"]
  21. let res = [IMap.find 0 map; IMap.find 1 map; IMap.find 2 map]
  22. (* res = ["salade";"brebis";"loup"] *)

Solution :


  1. let sum_list left right =
  2. List.combine left right
  3. |> List.map (fun (l,r) -> l+r)


  4. let reverse_even_length lists =
  5. let reverse_if_even list =
  6. if List.length list mod 2 = 0 then List.rev list else list
  7. in
  8. List.map reverse_if_even lists


  9. let rec pairing = function
  10. | [] -> []
  11. | one::two::more -> (one + two) :: pairing more
  12. | [single] -> [single]


  13. let int_map_of_list list =
  14. list
  15. |> List.mapi (fun i elt -> (i,elt))
  16. |> List.fold_left (fun map (i,elt) -> IMap.add i elt map) IMap.empty

Exercice 2 : Substitutions (6 points)

Évaluer par substitutions successives les quatre expressions suivantes. Vous utiliserez la règle selon laquelle List.map f [e1;...en] --> [f e1; ... f en].


  1. let rec insert pos elt list =
  2. match list with
  3. | _ when pos = 0 -> elt::list
  4. | [] -> [elt]
  5. | head::tail -> head :: insert (pos - 1) elt tail

  6. let evaluer_1 = insert 4 42 [1;9;2;8;7;5;4]


  7. let rec merge left right =
  8. match left, right with
  9. | l::eft, r::ight when l <= r -> l :: merge eft right
  10. | l::eft, r::ight -> r :: merge left ight
  11. | l, [] | [], l -> l


  12. let evaluer_2 = merge [1;4;6;8] [2;3;5]



  13. let add_head head lists = lists @ List.map (fun l -> head::l) lists
  14. let rec sublists list =
  15. match list with
  16. | [] -> [[]]
  17. | head::tail -> add_head head (sublists tail)


  18. let evaluer_3 = sublists [1;2]


  19. type position = L | M | R (* Left | Middle | Right *)

  20. let rec hanoi from_pos to_pos ignore_pos order =
  21. match order with
  22. | 0 -> []
  23. | n ->
  24. hanoi from_pos ignore_pos to_pos (n-1)
  25. @ [(from_pos, to_pos)]
  26. @ hanoi ignore_pos to_pos from_pos (n-1)

  27. let evaluer_4 = hanoi L M R 2

Solution :

  1. insert 4 42 [1;9;2;8;7;5;4]
  2. --> 1 :: insert 3 42 [9;2;8;7;5;4]
  3. --> 1 :: 9 :: insert 2 42 [2;8;7;5;4]
  4. --> 1 :: 9 :: 2 :: insert 1 42 [8;7;5;4]
  5. --> 1 :: 9 :: 2 :: 8 :: insert 0 42 [7;5;4]
  6. --> [ 1; 9; 2; 8; 42; 7; 5; 4]

  7. merge [1;4;6;8] [2;3;5]
  8. --> 1 :: merge [4;6;8] [2;3;5]
  9. --> 1 :: 2 :: merge [4;6;8] [3;5]
  10. --> 1 :: 2 :: 3 :: merge [4;6;8] [5]
  11. --> 1 :: 2 :: 3 :: 4 :: merge [6;8] [5]
  12. --> 1 :: 2 :: 3 :: 4 :: 5 :: merge [6;8] []
  13. --> [ 1; 2; 3; 4; 5; 6; 8 ]

  14. sublists [1;2]
  15. --> add_head 1 (sublists [2])
  16. --> add_head 1 (add_head 2 (sublists []))
  17. --> add_head 1 (add_head 2 [[]]
  18. --> add_head 1 ([[]] @ List.map (fun l -> 2::l) [[]])
  19. --> add_head 1 [ []; [2] ]
  20. --> [ []; [2]] @ List.map (fun l -> 1::l) [ []; [2] ]
  21. --> [ []; [2]; [1]; [1;2] ]


  22. hanoi L M R 2
  23. --> (hanoi L R M 1) @ [(L,M)] @ (hanoi R M L 1)
  24. --> (hanoi L R M 1) @ [(L,M)] @ (hanoi R L M 0) @ [(R,M)] @ (hanoi L M R 0)
  25. --> (hanoi L R M 1) @ [(L,M)] @ (hanoi R L M 0) @ [(R,M)] @ []
  26. --> (hanoi L R M 1) @ [(L,M)] @ [] @ [(R,M)] @ []
  27. --> (hanoi L M R 0) @ [(L,R)] @ (hanoi R M L 0) @ [(L,M)] @ [] @ [(R,M)] @ []
  28. --> (hanoi L M R 0) @ [(L,R)] @ [] @ [(L,M)] @ [] @ [(R,M)] @ []
  29. --> [] @ [(L,R)] @ [] @ [(L,M)] @ [] @ [(R,M)] @ []
  30. --> [(L,R); (L,M); (R,M)]

Exercice 3 : Exercice de style (4 points)

La fonction suivante fut écrite n'importe comment. Réécrivez-la de façon lisible. Ensuite, réécrivez-la sans récursion en utilisant les fonctionnelles de listes.

  1. let rec bad f q r = match q
  2. with | y1::x1 -> ( match r with
  3. | y2::x2 ->
  4. bad f q
  5. x2 @ bad f x1
  6. [y2] @ [ (f y1
  7. y2) ]
  8. | [] ->
  9. []) | [] -> []

Solution :

  1. (* On réindente *)
  2. let rec bad f q r =
  3. match q with
  4. | y1::x1 ->
  5. ( match r with
  6. | y2::x2 -> bad f q x2 @ bad f x1 [y2] @ [ (f y1 y2) ]
  7. | [] -> []
  8. )
  9. | [] -> []

  10. (* On renomme les variables, on supprime l'imbrication des matchs,
  11. et plus compliqué, on supprime l'utilisation de (@)
  12. *)
  13. let map_product f list1 list2 =
  14. let rec loop accu list1 list2 =
  15. match list1, list2 with
  16. | head1::tail1, head2::tail2 ->
  17. loop (loop (f head1 head2 :: accu) tail1 [head2]) list1 tail2
  18. | [], _
  19. | _, [] -> accu
  20. in loop [] list1 list2

  21. (* Puis on le réécrit avec des fonctionnelles *)
  22. let map_product f list1 list2 =
  23. let (>>=) list g = List.map g list |> List.flatten in
  24. List.rev (
  25. list1 >>= fun x1 ->
  26. list2 >>= fun x2 -> [ f x1 x2 ]
  27. )

Exercice 4 : Timsort (6 points)

L'algorithme Timsort est un algorithme de tri, utilisé notamment par Python. En début d'année 2015, des chercheurs ont voulu démontrer formellement la correction de son implémentation en Java, et se sont rendus compte que les implémentations dans différents langages, dont Java, Python et Haskell, étaient fausses.

Nous allons écrire une version correcte d'une version allégée de Timsort.

Nous commençons par le tri de listes d'entiers uniquement.

Couper un préfixe monotone croissant

Timsort utilise les séquences déjà triées de la liste pour aller plus vite. L'algorithme suivant trouve le plus long préfixe d'une liste qui est une séquence croissante.

  1. let rec cut_increasing_prefix accu list =
  2. match list with
  3. | one::two::more when one <= two ->
  4. cut_increasing_prefix (one::accu) (two::more)
  5. | one::more -> (List.rev (one::accu), more)
  6. | [] -> (List.rev accu, [])

Utilisez-le pour évaluer par substitution l'expression suivante :

  1. let _ = cut_increasing_prefix [] [1;3;6;7;5;2;4;8;9]

Solution :

  1. cut_increasing_prefix [] [1;3;6;7;5;2;4;8;9]
  2. --> cut_increasing_prefix [1] [3;6;7;5;2;4;8;9]
  3. --> cut_increasing_prefix [3;1] [6;7;5;2;4;8;9]
  4. --> cut_increasing_prefix [6;3;1] [7;5;2;4;8;9]
  5. --> (List.rev [7;6;3;1], [3;6;7;5;2;4;8;9])
  6. --> ([1;3;6;7], [3;6;7;5;2;4;8;9])
Couper un plus long préfixe monotone

Sur le même principe, écrire une fonction trouvant le plus long préfixe décroissant, et le retournant trié par ordre croissant.

Solution :

  1. let rec cut_decreasing_prefix accu list =
  2. match list with
  3. | one::two::more when one >= two ->
  4. cut_decreasing_prefix (one::accu) (two::more)
  5. | one::more -> (one::accu, more)
  6. | [] -> (accu,[])
Découper une liste en séquences croissantes

Maintenant, écrivez une fonction qui prend une liste d'entiers, et partitionne cette liste en séquence monotone.

  1. val monotonic_partition : int list -> int list list

Solution :

  1. let rec monotonic_partition incseqs list =
  2. match list with
  3. | one::two::more when one <= two ->
  4. let (prefix,suffix) = cut_increasing_prefix [] list in
  5. monotonic_partition (prefix::incseqs) suffix
  6. | one::two::more ->
  7. let (prefix,suffix) = cut_decreasing_prefix [] list in
  8. monotonic_partition (prefix::incseqs) suffix
  9. | [single] -> [single] :: incseqs
  10. | [] -> incseqs
Fusionner deux listes

Donnez une fonction pour fusionner deux listes croissantes en une seule liste croissante.

Solution :

On utilise la librairie standard.

  1. let merge = List.merge (fun a b -> a - b)
Insérer une séquence dans la pile.

Il suffit maintenant de fusionner toutes les listes. Malheureusement, si nous les fusionnons dans un ordre arbitraire, la complexité dans le pire des cas sera $O(n^2)$ pour $n$ éléments. La clé pour obtenir une complexité de $O(n \log n)$ est de fusionner uniquement des listes dont les longueurs sont proches, par exemple, qui diffèrent d'un facteur au plus 2.

Voilà comment nous allons procéder : nous construisons une liste de séquences croissantes, que nous appellons la pile. De plus la pile est triée par longueur de séquences croissantes, et ne contient pas deux séquences de longueurs proches.

Précisement, si la pile contient les séquences $s_1, s_2, \ldots s_k$(rappelons que $s_i$ est une liste d'entiers triés par ordre croissant), de longueurs $l_1,\ldots,l_k$, alors les propriétés suivantes doivent être vraies :

  • $l_1 \leq l_2 \leq l_3 \leq \ldots \leq l_k$,
  • $l_i + l_{i+1} < l_{i+2}$ pour tout $i \in {1,2,\ldots,k-2}$.

(En effet, si le second invariant est faux pour $i$, alors $l_{i+2} \leq l_{i+1} + l_i \leq 2 l_{i+1}$, donc $s_{i+1}$ et $s_{i+2}$ ont des longueurs proches.)

Nous commençons par coder une fonction qui ajoute une séquence dans la pile. Pour ne pas recalculer systématiquement les longueurs des listes, la pile contient des couples (liste d'entiers croissante, longueur de la liste). Pour ajouter une séquence, nous l'insérons en tête de liste, puis nous vérifions les invariants, dans cet ordre :

Si le premier invariant est violé, on retire les deux premiers éléments, puis on réinsère le premier, puis le deuxième (en revérifiant les invariants à chaque fois).

Si le deuxième invariant est violé, on retire les trois premiers éléments, puis on insère la fusion du deuxième et du troisième, puis on insère le premier (en revérifiant les invariants à chaque fois).

Programmez cet algorithme avec deux fonctions mutuellement récursives :

  1. let rec check_invariant stack =
  2. (* TODO *)

  3. and insert_sequence seq stack = check_invariant (seq::stack)

  4. val check_invariant : (int list * int) list -> (int list * int) list
  5. val insert_sequence :
  6. int list * int -> (int list * int) list -> (int list * int) list

Solution :

  1. let rec check_invariant stack =
  2. match stack with
  3. | (seq1,len1)::(seq2,len2)::others when len1 > len2 ->
  4. others
  5. |> insert_sequence (seq1,len1)
  6. |> insert_sequence (seq2,len2)
  7. | (seq1,len1)::(seq2,len2)::(seq3,len3)::others when len1 + len2 >= len3 ->
  8. others
  9. |> insert_sequence (merge seq2 seq3, len2 + len3)
  10. |> insert_sequence (seq1,len1)
  11. | _ -> stack

  12. and insert_sequence seq stack = check_invariant (seq::stack)
Écrire l'algorithme

Nous avons maintenant tous les ingrédients pour écrire Timsort. Il faut :

  • partitionner la liste en séquences croissantes,
  • calculer la longueur de chacune,
  • les insérer une-par-une dans une pile initialement vide,
  • ensuite, fusionner les listes de la pile restante, par ordre de longueur croissante, (en pensant à oublier les indications de longueurs),
  • retourner le résultat.

En utilisant l'opérateur (|>) et les fonctions écrites, écrire le code de Timsort (7 lignes suffisent).

  1. val timsort : int list -> int list

Solution :

  1. let timsort list =
  2. list
  3. |> monotonic_partition []
  4. |> List.map (fun seq -> (seq, List.length seq))
  5. |> List.fold_left (fun st seq -> insert_sequence seq st) []
  6. |> List.map fst
  7. |> List.fold_left (List.merge compare) []
Généraliser

Sans écrire de code, décrivez comment vous feriez pour rendre notre algorithme polymorphe.

Solution :Pour suivre l'interface du module de listes de la librairie standard, notre fonction de tri devrait prendre en argument un opérateur de comparaison. Il faudrait aussi le passer aux fonctions effectuant des comparaisons.

Une autre possibilité est de créer un foncteur qui prend un module de type ordonné et crée un module contenant la fonction de tri des listes de ce type. Dans ce cas, pas besoin d'ajouter l'opérateur de comparaison en argument, mais seulement remplacer toutes les comparaisons par celle définies dans le module en param^etre du foncteur.

Éléments de langage

Fonctions utiles de la librairie standard :

  1. val max : 'a -> 'a -> 'a (* calcule le maximum de deux valeurs *)
  2. val sqrt : float -> float (* calcule la racine carrée d'un nombre flottant *)
  3. val ( ** ) : float -> float -> float (* a ** b = a puissance b *)
  4. val (@) : 'a list -> 'a list -> 'a list (* concaténation de deux listes *)

  5. type 'elt option =
  6. | Some of 'elt
  7. | None

Fonctions utiles du module List :

  1. val hd : 'elt list -> 'elt
  2. val tl : 'elt list -> 'elt list
  3. val length : 'a list -> int
  4. val nth : 'a list -> int -> 'a
  5. val rev : 'a list -> 'a list
  6. val flatten : 'a list list -> 'a list
  7. val map : ('a -> 'b) -> 'a list -> 'b list
  8. val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
  9. val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
  10. val for_all : ('a -> bool) -> 'a list -> bool
  11. val exists : ('a -> bool) -> 'a list -> bool
  12. val mem : 'a -> 'a list -> bool
  13. val filter : ('a -> bool) -> 'a list -> 'a list
  14. val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list

Exemples de syntaxe :

  1. type ratio = int * int

  2. let rec euclid a b =
  3. if b = 0 then a
  4. else euclid b (a mod b)

  5. let pgcd a b = euclid (abs a) (abs b)

  6. let ratio p q =
  7. let d = pgcd p q in
  8. if q < 0 then (-p / d, q / d)
  9. else (p/d, q/d)

  10. let (+/) (a,b) (c,d) = ratio (a*d + b*c) (b*d)

  11. let (++) (a,b) (c,d) = ratio (a+c) (b+d)

  12. module Queue =
  13. struct

  14. type 'a t =
  15. Queue of ('a list) * ('a list)

  16. exception Empty

  17. let empty = Queue ([],[])

  18. let is_empty = function
  19. | Queue ([],[]) -> true
  20. | _ -> false

  21. let queue = function
  22. | Queue ([],l) -> Queue(List.rev l,[])
  23. | x -> x

  24. let snoc (Queue (l1,l2)) ele =
  25. queue (Queue (l1,ele::l2))

  26. let head = function
  27. | Queue ([],_) -> raise Empty
  28. | Queue (l,_) -> List.hd l

  29. let tail = function
  30. | Queue ([],_) -> raise Empty
  31. | Queue (l1,l2) -> queue (Queue (List.tl l1,l2))

  32. end