Programmation Fonctionnelle, Examen

Version & licenses
Creative Commons License

Programmation Fonctionnelle, Examen

Guyslain Naves

Exercice 1 : Manipulations de listes (4 points)

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

  1. (** [constant_list length elt] génére une liste de longueur [length],
  2. dont tous les éléments sont [elt]
  3. *)
  4. val constant_list : int -> 'elt -> 'elt list
  5. let res = constant_list 5 'a'
  6. val res : char list = [ 'a'; 'a'; 'a'; 'a'; 'a']

  8. (** Teste si toutes les listes contenues dans une liste ont longueur 5 *)
  9. val have_length_5 : 'elt list list -> bool

  11. (** [look_up key assoc] retourne [Some elt] si [(key,elt)] est dans [assoc],
  12. * et retourne [None] sinon.
  13. *)
  14. val look_up : 'key -> ('key * 'img) list -> 'img option
  15. let res = look_up 3 [ (2,'b'); (4,'d'); (3,'c'); (1,'a')]
  16. val res : char option = Some 'c'

  18. (** [factors list] est la liste de toutes les listes formées
  19. * en gardant des éléments consécutifs de list *)
  20. val factors : 'elt list -> 'elt list list
  21. let res = factors [1;3;2;4]
  22. val res : int list list =
  23. [ []; [1]; [3]; [2]; [4]; [1;3]; [3;2]; [2;4]; [1;3;2]; [3;2;4]; [1;3;2;4] ]

Solution :

  1. let rec constant length elt =
  2. if length <= 0 then []
  3. else elt::constant (length-1) elt

  5. let have_length_5 list = List.for_all (fun l -> List.length l = 5) list

  7. let rec look_up key = function
  8. | (k,img)::_ when k = key -> Some img
  9. | _::tail -> look_up key tail
  10. | [] -> None

  12. let rec suffixes = function
  13. | [] -> []
  14. | _::tail as list -> list :: suffixes tail

  16. let prefixes list = List.map List.rev (suffixes (List.rev list))

  18. let factors list =
  19. [] ::
  20. List.flatten
  21. (List.map prefixes (suffixes list))

Exercice 2 : Substitutions (6 points)

Évaluer par substitutions successives les expressions suivantes.

  1. let rec span predicat accepted list = match list with
  2. | head::tail when predicat head -> span predicat (head::accepted) tail
  3. | _ -> (List.rev accepted, list)
  4. in
  5. let test = (fun n -> n > 5) in
  6. span test [] [7;6;5;4;3;2;1]

  8. let rec make f init = match f init with
  9. | Some e -> e :: make f e
  10. | None -> []
  11. in let pred = function
  12. | 0 -> None
  13. | n -> Some (n-1)
  14. in make pred 4

  16. let rec collatz i = function
  17. | 1 -> i
  18. | n when n mod 2 = 0 -> collatz (i+1) (n/2)
  19. | n -> collatz (i+1) (3 * n + 1)
  20. in collatz 1 3

  22. let rec interlace list1 list2 = match list1, list2 with
  23. | [], l -> l
  24. | head::tail,l -> head :: interlace l tail
  25. in interlace [1;2;3] [4;5]

Solution :

  1. span test [] [7;6;5;4;3;2;1]
  2. --> span test [7] [6;5;4;3;2;1]
  3. --> span test [6;7] [5;4;3;2;1]
  4. --> ([7;6], [5;4;3;2;1])

  6. make pred 4
  7. --> 3 :: make pred 3
  8. --> 3 :: 2 :: make pred 2
  9. --> 3 :: 2 :: 1 :: make pred 1
  10. --> 3 :: 2 :: 1 :: 0 :: make pred 0
  11. --> [ 3; 2; 1; 0 ]

  13. collatz 1 3
  14. --> collatz 2 10
  15. --> collatz 3 5
  16. --> collatz 4 16
  17. --> collatz 5 8
  18. --> collatz 6 4
  19. --> collatz 7 2
  20. --> collatz 8 1
  21. --> 8

  23. interlace [1;2;3] [4;5]
  24. --> 1 :: interlace [4;5] [2;3]
  25. --> 1 :: 4 :: interlace [2;3] [5]
  26. --> 1 :: 4 :: 2 :: interlace [5] [3]
  27. --> 1 :: 4 :: 2 :: 5 :: interlace [3] []
  28. --> 1 :: 4 :: 2 :: 5 :: 3 :: interlace [] []
  29. --> [ 1; 4; 2; 5; 3 ]

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_function a =
  2. match a with
  3. | (k, []) :: z -> bad_function
  4. z
  5. | (k, x::y)
  6. ::z -> if k then x + bad_function
  7. ((true, y) :: z)
  8. else bad_function ((false,y)
  9. ::z)
  10. | _ -> 0

Solution :

  1. let rec sum_of_ok_lists = function
  2. | (false,_)::tail -> sum_of_ok_lists tail
  3. | (true,int::int_list)::tail -> int + sum_of_ok_lists ((true,int_list)::tail)
  4. | (true,[])::tail -> sum_of_ok_lists tail
  5. | [] -> 0

  7. let sum_of_ok_lists list =
  8. List.filter fst list
  9. |> List.map snd
  10. |> List.flatten
  11. |> List.fold_left (+) 0

Exercice 4 : 2048 (6 points)

2048 est le nom d'un jeu ayant récemment fait le buzz sur Internet. Il se présente sous la forme d'un damier de dimension 4x4 . Chaque case est vide, ou bien contient une seule tuile sur laquelle figure un entier. Le joueur choisit à chaque tour une des quatre directions (haut, bas, gauche, droite), et cela pousse au maximum toutes les tuiles dans cette direction. Les tuiles ne peuvent pas se superposer, mais lorsque deux tuiles de même valeur sont poussées l'une vers l'autre, elles fusionnent en une seule tuile de valeur double.

Il n'est pas utile de connaître le jeu pour résoudre les questions suivantes.

Nous représentons une position du jeu grâce aux types suivants :

  1. type tile = int option
  2. type line = tile list
  3. type table = line list

L'exemple suivant nous servira à plusieurs reprises.

  1. let t : table =
  2. [ [ None; Some 2; None; None ];
  3. [ None; Some 4; Some 8; None ];
  4. [ None; Some 2; Some 4; Some 4 ];
  5. [ None; Some 2; Some 4; Some 2 ]
  6. ]

La première liste représente donc la ligne du haut, de gauche à droite, et ainsi de suite.

Faire tomber une ligne

Voici le code de la fonction faisant tomber les tuiles d'une ligne vers la gauche :

  1. let fall_line : line -> line = fun line ->
  2. let rec loop none_tiles = function
  3. | Some i :: Some j :: tail when i = j -> Some (i+j) :: loop (None :: none_tiles) tail
  4. | Some i :: None :: tail -> loop (None :: none_tiles) (Some i :: tail)
  5. | Some i :: tail -> Some i :: loop none_tiles tail
  6. | None :: tail -> loop (None :: none_tiles) tail
  7. | [] -> none_tiles
  8. in loop [] line

Calculer le résultat de fall_line [ Some 4; None; Some 4; Some 8; None; Some 2 ], en procédant par substitutions successives.

Solution :

  1. fall_line [ Some 4; None; Some 4; Some 8; None; Some 2 ]
  2. --> loop [] [ Some 4; None; Some 4; Some 8; None; Some 2 ]
  3. --> loop [None] [ Some 4; Some 4; Some 8; None; Some 2 ]
  4. --> Some 8 :: loop [None; None] [ Some 8; None; Some 2 ]
  5. --> Some 8 :: loop [None; None; None] [ Some 8; Some 2 ]
  6. --> Some 8 :: Some 8 :: loop [None; None; None] [Some 2]
  7. --> Some 8 :: Some 8 :: Some 2 :: loop [None; None; None] []
  8. --> [ Some 8; Some 8; Some 2; None; None; None ]
Faire tomber les tuiles à gauche

Pour faire tomber tout le damier, il suffit de faire tomber chaque ligne indépendamment. En déduire la fonction qui prend un tableau et fait tomber les tuiles de chaque ligne vers la gauche.

  1. val fall_leftward : table -> table
  2. let t' = fall_leftward t
  3. val t' : table =
  4. [ [ Some 2; None; None; None];
  5. [ Some 4; Some 8; None; None];
  6. [ Some 2; Some 8; None; None];
  7. [ Some 2; Some 4; Some 2; None] ]

Solution :

  1. let fall_leftward table = List.map fall_line table
Faire tourner le tableau

Pour faire tomber les tuiles dans les autres directions, il suffit de savoir faire tourner le tableau de 90 degrés, pour se ramener à fall_leftward. Écrire une fonction effectuant une telle rotation (dans le sens horaire) du tableau.

Remarquez que la $k^\textrm{e}$ ligne après la rotation correspond à la $k^\textrm{e}$ colonne avant la rotation, en sens inverse.

Pour cette question, vous avez exceptionnellement le droit d'utiliser List.hd pour récupérer le premier élément d'une liste, et List.tl pour récupérer la queue d'une liste.

  1. val clockwise_rotation : table -> table
  2. let t'' = clockwise_rotation t;;
  3. val t'' : table =
  4. [ [ None; None; None; None ];
  5. [ Some 2; Some 2; Some 4; Some 2 ];
  6. [ Some 4; Some 4; Some 8; None ];
  7. [ Some 2; Some 4; None; None ] ]

Solution :

  1. let rec clockwise_rotation : table -> table = fun table ->
  2. if List.exists (fun l -> l = []) table then []
  3. else
  4. List.rev (List.map List.hd table) :: clockwise_rotation (List.map List.tl table)
Faire tomber les tuiles dans les autres directions

En déduire les fonctions pour faire tomber les tuiles dans les autres directions.

  1. val fall_downward : table -> table
  2. val fall_rightward : table -> table
  3. val fall_upward : table -> table

Solution :

  1. let (@@) f g x = f (g x) (** combinateur de composition de fonctions *)
  2. let half_rotation = clockwise_rotation @@ clockwise_rotation
  3. let anti_clockwise_rotation = clockwise_rotation @@ half_rotation

  5. let fall_upward = clockwise_rotation @@ fall_leftward @@ anti_clockwise_rotation
  6. let fall_rightward = half_rotation @@ fall_leftward @@ half_rotation
  7. let fall_downward = anti_clockwise_rotation @@ fall_leftward @@ clockwise_rotation
Question bonus : Rajouter une tuile

Seulement si vous avez fini toutes les autres questions !

Après chaque tour du joueur, une tuile est ajoutée dans une position vide choisie aléatoirement. La nouvelle tuile aura la valeur $2$ avec probabilité $0.9$, et $4$ avec probabilité $0.1$. Coder une fonction permettant l'ajout d'une tuile selon ce procédé.

Solution :

  1. let on_none value = function
  2. | None -> [value]
  3. | Some _ -> []
  4. let rec on_list f = function
  5. | head::tail -> List.map (fun im -> im::tail) (f head) @ List.map (fun l -> head::l) (on_list f tail)
  6. | [] -> []

  8. let fill_an_empty_square : table -> table option = fun table ->
  9. let value = if Random.int 10 = 0 then 4 else 2 in
  10. match on_list (on_list (on_none (Some value))) table with
  11. | [] -> None
  12. | choices -> Some (List.nth choices (Random.int (List.length choices)))

É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