Programmation Fonctionnelle, Examen

Version & licenses
Creative Commons License

Programmation Fonctionnelle, Examen

Guyslain Naves

La clarté du code compte autant que sa correction sémantique. Ainsi la notation tiendra compte des qualités de lisibilité des codes écrits. Les traits impératifs d'Ocaml (vu au dernier cours) ne doivent pas être utilisés (ceci comprend : références, champs mutables, tableaux, exceptions, objets et classes).

Écriture de fonctions élémentaires.

Expressions régulières, nombre d'étoiles.

On se donne le type suivant pour représenter des expresssions régulières.

  1. type regular_expression =
  2. | Epsilon (* langage vide *)
  3. | Letter of char (* exemple : a *)
  4. | Concat of regular_expression * regular_expression (* exemple : ab *)
  5. | Union of regular_expression * regular_expression (* exemple : (a|b) *)
  6. | Star of regular_expression (* exemple : a* *)

Voici quelques exemples d'expressions régulières, avec leur notation standard en commentaires, qui seront utilisés dans les tests :

  1. let (^) regexp1 regexp2 = Concat (regexp1, regexp2)
  2. let (||) regexp1 regexp2 = Union (regexp1, regexp2)

  4. let some_regexps =
  5. [ (Letter 'a' || Epsilon) ^ Letter 'b'; (* (a|epsilon)b *)
  6. Star (Letter 'a') ^ Star (Letter 'b'); (* a*b* *)
  7. Star (Letter 'b' ^ Star(Letter 'a') ^ Letter 'b'); (* (ba*b)* *)
  8. Star Epsilon ^ Letter 'a' ^ Letter 'b'; (* epsilon*ab *)
  9. ]

Écrire une fonction comptant le nombre d'étoiles d'une expression régulière.

  1. val count_kleene_stars : regular_expression -> int = <fun>

  3. let tests_count_kleene_stars () =
  4. assert (List.map count_kleene_stars some_regexps = [ 0; 2; 2; 1 ])

Solution :

  1. let rec count_kleene_stars = function
  2. | Epsilon
  3. | Letter _ -> 0
  4. | Concat (left_expr, right_expr)
  5. | Union (left_expr, right_expr) ->
  6. count_kleene_stars left_expr + count_kleene_stars right_expr
  7. | Star expr -> 1 + count_kleene_stars expr

Expressions régulières, longueur maximum d'un mot.

On se propose de calculer la longueur maximum d'un mot du langage associé à une expression régulière. Puisque cette longueur peut être indéfinie, on utilise le type suivant :

  1. type length =
  2. | Finite of int
  3. | Infinite

Donner le code de trois fonctions, calculant respectivement la somme de deux longueurs, le maximum de deux longueurs, et la longueur maximum d'un mot du langage associé à une expression régulière.

  1. val max_length : length -> length -> length = <fun>
  2. val add_length : length -> length -> length = <fun>
  3. val length_of_longuest_word : regular_expression -> length = <fun>

  5. let tests_length_longuest_word () =
  6. assert (
  7. List.map length_of_longuest_word some_regexps
  8. = [ Finite 2; Infinite; Infinite; Finite 2 ]
  9. )

Solution :

  1. let lift_int_operator_to_length (++) length0 length1 =
  2. match length0, length1 with
  3. | Infinite,_
  4. | _, Infinite -> Infinite
  5. | Finite len0, Finite len1 -> Finite (len0 ++ len1)

  7. let max_length = lift_int_operator_to_length max
  8. let add_length = lift_int_operator_to_length (+)


  11. let rec length_of_longuest_word = function
  12. | Epsilon -> Finite 0
  13. | Letter _ -> Finite 1
  14. | Concat (left_expr, right_expr) ->
  15. add_length
  16. (length_of_longuest_word left_expr)
  17. (length_of_longuest_word right_expr)
  18. | Union (left_expr,right_expr) ->
  19. max_length
  20. (length_of_longuest_word left_expr)
  21. (length_of_longuest_word right_expr)
  22. | Star expr when length_of_longuest_word expr = Finite 0 ->
  23. Finite 0
  24. | Star expr -> Infinite

Somme d'entiers pairs.

Écrire une fonction prenant une liste d'entiers en paramêtre et retournant la somme des entiers pairs de cette liste.

  1. val sum_of_even_elements : int list -> int = <fun>

  3. let test_sum_of_even_elements () =
  4. assert (
  5. List.map sum_of_even_elements
  6. [ [1;2;3;4;5;6;7;8];
  7. [];
  8. [2;4;6;8];
  9. [7;5;3;1]
  10. ]
  11. = [ 20; 0; 20; 0]
  12. )

Solution :

  1. let sum_of_even_elements integers =
  2. integers
  3. |> List.filter (fun i -> i mod 2 = 0)
  4. |> List.fold_left (+) 0

Prénoms féminins.

Nous définissons les types suivants pour représenter les prénoms :

  1. type gender =
  2. | FemaleOnly
  3. | MaleOnly
  4. | Any

  6. type first_name =
  7. { name : string;
  8. gender : gender
  9. }

Écrire une fonction qui prend en paramêtre une liste de prénoms, et retourne les chaînes de caractères pouvant faire office de prénoms féminins.

  1. val extract_first_names_suitable_for_female :
  2. first_name list -> string list = <fun>

  4. let test_extract_first_names_suitable_for_female =
  5. assert (
  6. extract_first_names_suitable_for_female
  7. [ { name = "Camille"; gender = Any };
  8. { name = "Alphonse"; gender = MaleOnly };
  9. { name = "Diane"; gender = FemaleOnly };
  10. { name = "Gérard"; gender = MaleOnly };
  11. { name = "Sophie"; gender = FemaleOnly }
  12. ]
  13. = ["Camille"; "Diane"; "Sophie"]
  14. )

Solution :

  1. let extract_first_names_suitable_for_female first_names =
  2. first_names
  3. |> List.filter (fun first_name -> first_name.gender <> MaleOnly)
  4. |> List.map (fun first_name -> first_name.name)

Map de deux listes.

List.map applique une fonction à tous les éléments d'une liste. Soit $f$ une fonction à deux arguments. Écrire une fonction qui applique $f$ (donnée en paramêtre) à toutes les paires d'éléments apparaissant en même position dans deux listes (voir les exemples).

  1. val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>

  3. let tests_map2 =
  4. assert (map2 (+) [1;2;3] [40;50;20;30] = [41; 52; 23]);
  5. assert (map2 (^) ["ba";"be";"bi"] ["dou";"di"] = ["badou"; "bedi"])

Si l'une des listes est plus longue que l'autre, les éléments excédentaires sont ignorés.

Solution :

  1. let rec map2 ~f left_list right_list =
  2. match left_list, right_list with
  3. | [], _
  4. | _, [] -> []
  5. | left_head::left_tail, right_head::right_tail ->
  6. f left_head right_head :: map2 ~f left_tail right_tail

Paires d'éléments consécutifs d'une liste.

Utiliser la fonctionnelle map2 vue à la question précédente pour écrire une fonction retournant la liste des paires d'éléments consécutifs d'une liste, sans utiliser de récursion ni d'autre fonctionnelle.

  1. val pair_adjacent_items : 'a list -> ('a * 'a) list = <fun>

  3. let test_pair_adjacent_items () =
  4. assert (
  5. pair_adjacent_items [1;3;4;6;2;5]
  6. = [(1, 3); (3, 4); (4, 6); (6, 2); (2, 5)]
  7. )

Solution :

  1. let pair_adjacent_items list =
  2. match list with
  3. | [] -> []
  4. | head::tail ->
  5. map2 ~f:(fun previous next -> (previous,next))
  6. list
  7. tail

Évaluation par substitution.

Évaluer par substitutions successives les expressions indiquées. Votre réponse doit indiquer les principales étapes de l'évaluation, comme vu en TD.

  1. let rec drop n elements =
  2. match elements with
  3. | _ when n <= 0 -> elements
  4. | first::others -> drop (n-1) others
  5. | [] -> []

  7. let a_evaluer_1 = drop 5 [3;4;5;6;7;8;9;10]


  10. let rec move_head_to_last list =
  11. match list with
  12. | head :: second :: others ->
  13. second :: move_head_to_last (head::others)
  14. | _ -> list

  16. let a_evaluer_2 = move_head_to_last [5;2;6;4;3;1]


  19. let rec alternating_map ~f ~g list =
  20. match list with
  21. | head::tail -> f head :: alternating_map ~f:g ~g:f tail
  22. | [] -> []

  24. let a_evaluer_3 =
  25. let double x = 2 * x in
  26. let incr x = 1 + x in
  27. alternating_map ~f:double ~g:incr [1;2;3;4;5;6]

  29. let extend list =
  30. let rec traverse prefix suffix =
  31. match suffix with
  32. | [] ->
  33. [(prefix,[])]
  34. | element::remains ->
  35. (prefix,suffix) :: traverse (element::prefix) remains
  36. in
  37. traverse [] list

  39. let a_evaluer_4 = extend [1;2;3;4]

Solution :

  1. drop 5 [3;4;5;6;7;8;9;10]
  2. --> drop 4 [4;5;6;7;8;9;10]
  3. --> drop 3 [5;6;7;8;9;10]
  4. --> drop 2 [6;7;8;9;10]
  5. --> drop 1 [7;8;9;10]
  6. --> drop 0 [8;9;10]
  7. --> [8;9;10]

  9. move_head_to_last [5;2;6;4;3;1]
  10. --> 2 :: move_head_to_last [5;6;4;3;1]
  11. --> 2 :: 6 :: move_head_to_last [5;4;3;1]
  12. --> 2 :: 6 :: 4 :: move_head_to_last [5;3;1]
  13. --> 2 :: 6 :: 4 :: 3 :: move_head_to_last [5;1]
  14. --> 2 :: 6 :: 4 :: 3 :: 1 :: move_head_to_last [5]
  15. --> [2; 6; 4; 3; 1; 5]

  17. alternating_map ~f:double ~g:incr [1;2;3;4;5;6]
  18. --> 2 :: alternating_map ~f:incr ~g:double [2;3;4;5;6]
  19. --> 2 :: 3 :: alternating_map ~f:double ~g:incr [3;4;5;6]
  20. --> 2 :: 3 :: 6 :: alternating_map ~f:incr ~g:double [4;5;6]
  21. --> 2 :: 3 :: 6 :: 5 :: alternating_map ~f:double ~g:incr [5;6]
  22. --> 2 :: 3 :: 6 :: 5 :: 10 :: alternating_map ~f:incr ~g:double [6]
  23. --> 2 :: 3 :: 6 :: 5 :: 10 :: 7 :: alternating_map ~f:double ~g:incr []
  24. --> [ 2; 3; 6; 5; 10; 7 ]

  26. extend [1;2;3]
  27. --> traverse [] [1;2;3]
  28. --> ([],[1;2;3]) :: traverse [1] [2;3]
  29. --> ([],[1;2;3]) :: ([1],[2;3]) :: traverse [2;1] [3]
  30. --> ([],[1;2;3]) :: ([1],[2;3]) :: ([2;1],[3]) :: traverse [3;2;1] []
  31. --> [ ([],[1;2;3]); ([1],[2;3]); ([2;1],[3]); ([3;2;1],[]) ]

Une librairie de tests automatiques de code.

QuickCheck est une librairie Haskell pour l'écriture rapide de tests sur des fonctions, en les évaluant avec pour arguments des valeurs obtenues aléatoirement. Cela a inspiré des équivalents dans d'autres langages de programmation, dont OCaml (qcheck, quickcheck par exemple). Dans cet exercice, nous construisons une mini-librairie basée sur les mêmes principes, simplifiés à l'extrême.

Voici un exemple d'utilisation de notre librairie :

  1. # let test_every_odd_int_is_prime =
  2. Test.asserts Generator.int (fun i -> is_even i || is_prime i)
  3. val test_every_odd_int_is_prime : Test.t = Test.Test (<abstr>, <fun>)

  5. # let _ = Runner.run test_every_odd_int_is_prime
  6. Failed: 57: Assertion failed
  7. Failed: 87: Assertion failed
  8. Failed: 69: Assertion failed
  9. - : bool = false

Dans cet exemple, à la propriété que tout entier impair est premier, trois contre-exemples ont été trouvés, dont les valeurs sont indiquées.

Notre librairie se décompose en trois modules :

  1. Generator définit des fonctions pour décrire les générateurs aléatoires d'arguments pour les fonctions.
  2. Test permet d'écrire les tests proprement dit.
  3. Runner propose les fonctions pour exécuter les tests.

La génération d'arguments.

Pour simplifier, nous ne testerons que des fonctions manipulant des entiers, booléens, flottants et listes (pour commencer).

Voici l'interface du module Generator :

  1. module Generator : sig

  3. (** générateur d'arguments de type ['value] *)
  4. type 'value t

  6. val int : int t
  7. val float : float t
  8. val bool : bool t
  9. val list : 'value t -> 'value list t

  11. val return : description:string -> 'value -> 'value t
  12. val bind : 'init t -> ('init -> 'value t) -> 'value t
  13. val (>>=) : 'init t -> ('init -> 'value t) -> 'value t


  16. (** Représentation d'un argument généré. *)
  17. type 'value argument

  19. val get_value : 'value argument -> 'value
  20. val get_description : 'value argument -> string

  22. (* La fonction de génération d'un argument. *)
  23. val run : 'value t -> 'value argument

  25. end
  1. Quelle interface usuelle contient Generator ? À quoi le reconnaissez-vous ?

  2. Trouver un nom approprié pour l'expression suivante. Quel est son type ?

    1. let nom_inadequat =
    2. let open Generator in
    3. int >>= fun i ->
    4. int >>= fun j ->
    5. return ~description:(Printf.sprintf "(%d,%d)" i j) (i,j)
  3. Écrire une expression décrivant un argument de type float option.
  4. Écrire une expression décrivant un générateur d'arguments de type 'arg option, étant donné en paramêtre un générateur d'argument de type 'arg :
  1. val option : 'arg t -> 'arg option t

Solution :

  1. L'interface contient une fonction bind et une fonction return dont les types correspondent aux deux opérations d'une monade. On note cependant que return prend un argument supplémentaire description, donc c'est plutôt l'application return ~description à un premier argument qui joue le rôle de fonction return de la monade.

  2. Il s'agit d'une générateur de couple d'entiers, puisqu'on retourne $i$ et $j$ obtenu par un bind depuis un générateur d'entiers. Son type est donc (int * int) Generator.t, et on peut l'appeler int_pair_generator.

    La lecture de cet exemple doit aider à réaliser les question suivantes, notamment l'utilisation du bind pour récupérer les valeurs générés, et de return pour en générer explicitement de nouvelles.

  3. Pour générer une option, il faut décider si on veut générer Some ou None, puis dans le second cas générer un flottant. On commence donc par générer un booléen.

    1. let float_option_generator =
    2. bool >>= fun is_none ->
    3. if is_none then Generator.return ~description:"None"
    4. else ...

    Dans le deuxième cas, on génère en plus un flottant, et on retourne une option sur ce flottant.

    1. let float_option_generator =
    2. Generator.bool >>= fun is_none ->
    3. if is_none then Generator.return ~description:"None"
    4. else
    5. Generator.float >>= fun value ->
    6. let description = Printf.sprintf "Some %f" value in
    7. Generator.return ~description (Some value)

  4. Il suffit alors de généraliser le code précédant pour obtenir :

    1. let option_generator value_generator=
    2. Generator.bool >>= fun is_none ->
    3. if is_none then Generator.return ~description:"None"
    4. else
    5. value_generator >>= fun value ->
    6. let description = "an option" in
    7. Generator.return ~description (Some value)

    On remarque ici qu'on est géné pour décrire la valeur générée par une chaîne de caractères. Il nous manque une fonction bindplus générale, qui passerait aussi une description de la valeur générée à son deuxième argument.

L'écriture de tests.

Voici l'interface pour le module Test.

  1. module Test : sig
  2. type result =
  3. | Ok
  4. | ErrorMessage of string

  6. type t =
  7. Test : 'value Generator.t * ('value Generator.argument -> result) -> t


  10. val equals :
  11. ?compare:('result -> 'result -> int)
  12. -> gen:('value Generator.t)
  13. -> ('value -> 'result)
  14. -> ('value -> 'result)
  15. -> t

  17. val asserts :
  18. gen:('value Generator.t)
  19. -> ('value -> bool)
  20. -> t

  22. end

  1. Notez la syntaxe inhabituelle utilisée pour le type t. Quel erreur indiquerait le compilateur pour le type suivant ?

    1. type t = Test of 'value Generator.t * ('value Generator.argument -> result)

  2. asserts ~gen fct est le test vérifiant que fct retourne true pour les arguments générés par gen. Écrire la fonction suivante :

    1. val check_asserts : ('value -> bool) -> 'value Generator.argument -> result

    de sorte que asserts soit définie par~:

    1. let asserts ~gen fct = Test (gen, check_asserts fct)

    En cas d'erreur, le message d'erreur généré doit contenir une description de l'argument ayant provoqué l'erreur.

Solution :

  1. Le compilateur dirait que 'value n'est pas une variable de type liée. Il attendrait que 'value soit en paramêtre du type t.

  2. D'après les types dans l'interface de Generator, il faut utiliser Generator.run puis Generator.get_valuepour pouvoir obtenir une valeur à tester. On applique alors la fonction à tester et on poursuit selon le résultat (if) de cette application, en retournant Ok ou un message d'erreur.


    2. let check_asserts fct gen_value =
    3. let argument = Generator.run gen_value in
    4. if fct (Generator.get_value argument) then OK
    5. else
    6. let description = Generator.get_description argument in
    7. let msg = Printf.sprintf "%s: Assertion failed" description in
    8. ErrorMessage msg

Écriture et exécution de tests

Le dernier module a pour interface :

  1. module Runner : sig
  2. (* Exécute 10 fois le test, retourne [true] si toutes les tentatives
  3. ont réussis, [false] s'il y a eu au moins un échec. *)
  4. val run : Test.t -> bool
  5. end
  1. Écrire un test pour vérifier que renverser deux fois une liste avec List.rev redonne la liste de départ.
  2. Écrire un test pour vérifier que List.flatten conserve le nombre d'éléments des listes.
  3. Écrire la fonction Runner.run.

Solution :

    1. On écrit le générateur, en ouvrant localement {verb {:Generator:}}
    2. cela donne un code assez lisible. D'autre part on écrit la fonction de
    3. test. Ici le code est assez court, on peut se permettre de tout
    4. laisser en un bloc.

    6. Notons aussi que l'égalité de listes opère comme on le souhaite en OCaml.

    8. let do_test_list_rev =
    9. Runner.run
    10. Test (
    11. Generator.(list int),
    12. (fun list -> List.(list |> rev |> rev) = list)
    13. )

  2. Pour des raisons de clarté du code, on sort les fonctions de calculs de longueurs car elles sont plus complexes que dans le premier exemple.

    1. let length_of_flattening list = List.(list |> flatten |> length) in

    3. let length_of_list_list list =
    4. List.(list |> map length |> fold_left (+) 0)

    6. let do_test_flatten =
    7. Runner.run
    8. Test (
    9. Generator.(list (list int)),
    10. (fun list -> length_of_flattening list = length_of_list_list list)
    11. )

  3. Selon le résultat du test, on affiche éventuellement un message d'erreur. La difficulté est de récupérer le résultat du test. Generator.run permet de récupérer un Generator.argument, ce qui est attendu par la fonction de test test_fct pour donner le résultat du test.


    2. let run (Test (gen_value,test_fct)) =
    3. let test_result = gen_value |> Generator.run |> test_fct in
    4. match test_result with
    5. | OK -> true
    6. | ErrorMessage msg ->
    7. Printf.printf "%s\n%!" msg;
    8. false

É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 IntMap = Map.Make(struct type t = int let compare = compare end)

  20. module Queue =
  21. struct

  23. type 'a t =
  24. Queue of ('a list) * ('a list)

  26. exception Empty

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

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

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

  38. let snoc (Queue (l1,l2)) ele =
  39. queue (Queue (l1,ele::l2))

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

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

  49. end