Programmation Fonctionnelle, Examen, 2e session

Version & licenses
Creative Commons License

Programmation Fonctionnelle, Examen, 2e session

Guyslain Naves

Exercice 1 : Manipulations de listes (4 points)

Implémenter les 4 fonctions suivantes. Vous pouvez utiliser les fonctions de la librairie standard si vous le voulez.

  1. (** [choose i list] retourne une option sur le [i]e élément de la liste [list] (en partant de 0) *)
  2. val choose : int -> 'elt list -> 'elt option
  3. let res = choose 2 ['a';'b';'c';'d']
  4. val res : char option = Some 'c'
  5. let res' = choose 4 ['a';'b';'c';'d']
  6. val res' : char option = None

  8. (** [at_least_42 list] retourne la liste des entiers de [list] valant au moins 42. *)
  9. val at_least_42 : int list -> int list
  10. let res = at_leat_42 [5;42;13;56;87;3]
  11. val res : int list = [42;56;87]

  13. (** [stutter list] retourne la liste où chaque élément de [list] apparait deux fois, dans le même ordre *)
  14. val stutter : 'elt list -> 'elt list
  15. let res = stutter [1;2;3;4]
  16. val res : int list = [1;1;2;2;3;3;4;4]

  18. (** [stutter_4 list] agit comme [stutter], mais chaque élément est répété 4 fois *)
  19. val stutter_4 : 'elt list -> 'elt list
  20. let res = stutter [1;2;3]
  21. val res : int list = [1;1;1;1;2;2;2;2;3;3;3;3]

Solution :

  1. let rec choose n = function
  2. | head::_ when n = 0 -> Some head
  3. | _::tail -> choose (n-1) tail
  4. | [] -> Done

  6. let at_least_42 = List.filter (fun i -> i >= 42)

  8. let stutter list = List.map (fun elt -> [elt;elt]) list |> List.flatten

  10. let stutter_4 list = list |> stutter |> stutter

Exercice 2 : Substitutions (6 points)

Évaluer par substitutions successives les 4 expressions suivantes.

  1. let rec odd = fun list -> match list with
  2. | head::tail -> head :: even tail
  3. | [] -> []
  4. and even = fun list -> match list with
  5. | _::tail -> odd tail
  6. | [] -> []
  7. in odd [1;2;3;4;5;6] (* à évaluer *)

  9. let rec fib = fun i -> match i with
  10. | 0 | 1 -> [0]
  11. | _ -> (fib (i-1)) @ (fib (i-2))
  12. in fib 3 (* à évaluer *)

  14. (** pour l'expression [path 7 [] tree], vous pouvez dessiner les arbres plutôt que les écrire. *)
  15. (** Le dessin d'[init_tree] est donné plus bas. *)
  16. type tree = Leaf | Node of (tree * int * tree)
  17. let rec path = fun elt acc tree -> match tree with
  18. | Node (_,root,_) when elt = root -> Some (List.rev acc)
  19. | Node (left,root,_) when elt < root -> path elt (root::acc) left
  20. | Node (_,root,right) -> path elt (root::acc) right
  21. | Leaf -> None
  22. in
  23. let init_tree =
  24. Node (
  25. Node( Node(Node(Leaf,2,Leaf),3,Node(Leaf,4,Leaf)),
  26. 8,
  27. Node(Node(Leaf,9,Leaf),11,Leaf)
  28. ),
  29. 12,
  30. Node(Node(Leaf,13,Leaf), 15, Node(Leaf,18,Leaf))
  31. )
  32. in path 9 [] init_tree (* à évaluer *)



  36. let stack = fun one two (list1,list2) -> (one::list1,two::list2) in
  37. let rec split = fun list -> match list with
  38. | one::two::tail -> stack one two (split tail)
  39. | [one] -> ([one],[])
  40. | [] -> ([],[])
  41. in split [0;1;2;3;4;5;6] (* à évaluer *)
L'arbre init_tree.

Solution :

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

  11. fib 4
  12. --> fib 3 @ fib 2
  13. --> fib 2 @ fib 1 @ fib 2
  14. --> fib 1 @ fib 0 @ fib 1 @ fib 2
  15. --> fib 1 @ fib 0 @ fib 1 @ fib 1 @ fib 0
  16. --> [0] @ fib 0 @ fib 1 @ fib 1 @ fib 0
  17. --> [0] @ [0] @ fib 1 @ fib 1 @ fib 0
  18. --> ...
  19. --> [0] @ [0] @ [0] @ [0] @ [0]
  20. --> [0;0;0;0;0]

  22. path 9 [] init_tree
  23. --> path 9 [12]
  24. Node( Node(Node(Leaf,2,Leaf),3,Node(Leaf,4,Leaf)),
  25. 8,
  26. Node(Node(Leaf,9,Leaf),11,Leaf)
  27. )
  28. --> path 9 [8;12] Node(Node(Leaf,9,Leaf),11,Leaf)
  29. --> path 9 [11;8;12] Node(Leaf,9,Leaf)
  30. --> List.rev [11;8;12]
  31. --> [12;8;11]

  33. split [0;1;2;3;4;5;6]
  34. --> stack 0 1 (split [2;3;4;5;6])
  35. --> stack 0 1 (stack 2 3 (split [4;5;6])
  36. --> stack 0 1 (stack 2 3 (stack 4 5 (split [6])))
  37. --> stack 0 1 (stack 2 3 (stack 4 5 ([6],[]))
  38. --> stack 0 1 (stack 2 3 ([4;6],[5]))
  39. --> stack 0 1 ([2;4;6],[3;5])
  40. --> ([0;2;4;6],[1;3;5])

Exercice 4 : Tirage au sort de la Coupe du Monde (6 points)

La Coupe du Monde de football se déroule actuellement au Brésil. Nous allons coder l'algorithme qui a permis de tirer au sort les 8 poules de 4 équipes qui constituent la première partie de la compétition.

Les 32 équipes sont classés en quatre chapeaux (pots en anglais). Ces chapeaux correspondent pour le premier aux meilleures équipes du classement international, et pour les trois autres aux origines géographiques :

  1. type team = string
  2. type pot = team list

  4. let () = Random.self_init () (** pour initialiser le générateur aléatoire *)

  6. let pot1 = ["Brasil"; "Uruguay"; "Columbia"; "Argentina"; "Switzerland"; "Germany"; "Spain"; "Belgium"]
  7. let pot2 = ["Ghana"; "Ivory Coast"; "Algeria"; "Cameroon"; "Nigeria "; "Ecuador"; "Chile"]
  8. let pot3 = ["Iran"; "Mexico"; "United States"; "Costa Rica"; "Australia"; "Japan"; "South Korea"; "Honduras"]
  9. let pot4 = ["Netherlands"; "France"; "England"; "Portugal"; "Italy"; "Bosnia"; "Croatia"; "Greece"; "Russia"]

  11. let init_pots = [pot1; pot2; pot3; pot4]

On note que la taille des chapeaux est 8,7,8,9 respectivement. L'idée générale de l'algorithme est de constituer chaque poule (pool en anglais) en tirant une équipe dans chaque chapeau. Cela nécessite que chaque chapeau soit de taille 8 , donc dans une première étape, une équipe du chapeau 4 sera reversé dans le chapeau 2 .

Question 1 : Extraire un élément choisi aléatoirement dans une liste

On définit la fonction suivante pour choisir un élément aléatoire dans une liste.

  1. let choose_and_remove list =
  2. let index = Random.int (List.length list) in
  3. let rec remove i ignored list =
  4. match list with
  5. | head::tail when i = 0 -> (head,List.rev_append ignored tail)
  6. | head::tail -> remove (i-1) (head::ignored) tail
  7. | [] -> assert false
  8. in remove index [] list

Évaluer par substitutions successives l'expression :

  1. choose_and_remove [2;1;4;6;3;5]

en supposant que l'appel Random.int 6 renvoie 3 . (Pour rappel, Random.int n s'évalue en un entier compris entre $0$ et $n-1$ inclus, choisi aléatoirement.)

Quel est le type de choose_and_remove ? (ne pas justifier la réponse)

Solution :

  1. choose_and_remove [2;1;4;6;3;5]
  2. --> remove 3 [] [2;1;4;6;3;5]
  3. --> remove 2 [2] [1;4;6;3;5]
  4. --> remove 1 [1;2] [4;6;3;5]
  5. --> remove 0 [4;1;2] [6;3;5]
  6. --> (6, List.rev_append [4;1;2] [3;5])
  7. --> (6, [2;1;4;3;5])

Le type de choose_and_remove est 'elt list -> 'elt * 'elt list.

Question 2 : Appliquer une fonction à un élément.

Nous souhaitons modifier une liste en appliquant une fonction à son $i$e élément, les autres éléments restant inchangés. Écrire la fonction suivante pour se faire :

  1. val apply_at_nth : ('elt -> 'elt) -> int -> 'elt list -> 'elt list

  3. let res = apply_at_nth (fun x -> 3 * x) 2 [1;2;3;4;5]
  4. val res : int list = [1; 2; 9; 4; 5]
  5. let res' = apply_at_nth (fun x -> 3 * x) 4 [1;2;3;4;5]
  6. val res' : int list = [1; 2; 3; 4; 15]

S'il n'y a pas de $i$e élément, la liste evaluée est identique à celle passée en argument.

En déduire une fonction permettant de remplacer le $i$e élément par un autre :

  1. val replace_nth : int -> 'elt -> 'elt list -> 'elt list

  3. let res = replace_nth 2 42 [1;2;3;4;5];;
  4. val res : int list = [1; 2; 42; 4; 5]
  5. let res' = replace_nth 4 42 [1;2;3;4;5];;
  6. val res' : int list = [1; 2; 3; 4; 42]

Solution :

  1. let rec apply_at_nth f n list =
  2. match list with
  3. | head::tail when n = 0 -> f head :: tail
  4. | head::tail -> head :: apply_at_nth f (n-1) tail
  5. | [] -> []

  7. let replace_nth n elt list = apply_at_nth (fun _ -> elt) n list
Question 3 : Reverser du chapeau $i$ vers le chapeau $j$

Écrire une fonction prenant une liste de chapeau (type pot), et qui retire une équipe choisit aléatoirement dans le $i$e chapeau, et l'ajoute au $j$e chapeau.

  1. val initial_move : int -> int -> pot list -> pot list
  2. let after_balance = initial_move 4 2 init_pots;; (* i = 4, j = 2 *)
  3. val after_balance : pot list =
  4. [["Brasil"; "Uruguay"; "Columbia"; "Argentina"; "Switzerland"; "Germany"; "Spain"; "Belgium"];
  5. ["Russia"; "Ghana"; "Ivory Coast"; "Algeria"; "Cameroon"; "Nigeria "; "Ecuador"; "Chile"];
  6. ["Iran"; "Mexico"; "United States"; "Costa Rica"; "Australia"; "Japan"; "South Korea"; "Honduras"];
  7. ["Netherlands"; "France"; "England"; "Portugal"; "Italy"; "Bosnia"; "Croatia"; "Greece"]
  8. ]
  9. (* Ici, la Russie a été reversée vers le pot 2 *)

Vous pouvez utiliser la fonction List.nth : 'elt list -> int -> 'elt pour récupérer un élément en position $i$ dans la liste (attention : le premier élément est en position 0).

Solution :

  1. let initial_move exc def init_pots =
  2. let (team_exc,pot_exc) = choose_and_remove (List.nth init_pots (exc-1)) in
  3. init_pots
  4. |> apply_at_nth (fun pot_def -> team_exc::pot_def) (def-1)
  5. |> replace_nth (exc-1) pot_exc
Question 4 : Tirer une poule

Écrire une fonction make_a_pool : pot list -> team list * pot list, qui choisit aléatoirement une équipe de chaque chapeau, et retourne la poule ainsi formée, ainsi que la liste des chapeaux sans ces équipes. Vous pouvez supposer que chaque chapeau est non-vide, mais la liste des chapeaux peut être de n'importe quelle longueur.

  1. let pool_example = make_a_pool after_balance
  2. val pool_example : string list * string list list =
  3. ( ["Belgium"; "Cameroon"; "Japan"; "France"],
  4. [ ["Brasil"; "Uruguay"; "Columbia"; "Argentina"; "Switzerland"; "Germany"; "Spain"];
  5. ["Russia"; "Ghana"; "Ivory Coast"; "Algeria"; "Nigeria "; "Ecuador"; "Chile"];
  6. ["Iran"; "Mexico"; "United States"; "Costa Rica"; "Australia"; "South Korea"; "Honduras"];
  7. ["Netherlands"; "England"; "Portugal"; "Italy"; "Bosnia"; "Croatia"; "Greece"]])

Solution :

  1. let make_a_pool state =
  2. List.map choose_and_remove state
  3. |> List.split
Question 5 : Tirer toutes les poules

En déduire une fonction draw_world_cup : unit -> team list list, retournant une liste de poules pour la Coupe du Monde, tirée selon les règles.

  1. # let _ = draw_world_cup ();;
  2. - : string list list =
  3. [ ["Argentina"; "Cameroon"; "United States"; "Portugal"];
  4. ["Spain"; "Ivory Coast"; "Mexico"; "Bosnia"];
  5. ["Brasil"; "Ecuador"; "Japan"; "Netherlands"];
  6. ["Belgium"; "Algeria"; "South Korea"; "Greece"];
  7. ["Uruguay"; "Chile"; "Costa Rica"; "England"];
  8. ["Germany"; "Nigeria "; "Australia"; "Russia"];
  9. ["Columbia"; "Ghana"; "Honduras"; "Italy"];
  10. ["Switzerland"; "Croatia"; "Iran"; "France"]
  11. ]

Solution :

  1. let rec make_all_pools pools pots =
  2. if List.for_all (fun pot -> pot = []) pots then pools
  3. else
  4. let (one_pool,next_pots) = make_a_pool pots in
  5. make_all_pools (one_pool::pools) next_pots

  7. let draw_world_cup () = make_all_pools [] (initial_move 4 2 init_state)

É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 *)

  6. type 'elt option =
  7. | Some of 'elt
  8. | 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

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

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

  9. let ratio p q =
  10. let d = pgcd p q in
  11. if q < 0 then (-p / d, q / d)
  12. else (p/d, q/d)

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

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

  18. module Queue =
  19. struct

  21. type 'a t =
  22. Queue of ('a list) * ('a list)

  24. exception Empty

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

  28. let is_empty = function
  29. | Queue ([],[]) -> true
  30. | _ -> false

  32. let queue = function
  33. | Queue ([],l) -> Queue(List.rev l,[])
  34. | x -> x

  36. let snoc (Queue (l1,l2)) ele =
  37. queue (Queue (l1,ele::l2))

  39. let head = function
  40. | Queue ([],_) -> raise Empty
  41. | Queue (l,_) -> List.hd l

  43. let tail = function
  44. | Queue ([],_) -> raise Empty
  45. | Queue (l1,l2) -> queue (Queue (List.tl l1,l2))

  47. end