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.
type regular_expression =
| Epsilon
| Letter of char
| Concat of regular_expression * regular_expression
| Union of regular_expression * regular_expression
| Star of regular_expression
Voici quelques exemples d'expressions régulières, avec leur notation standard en commentaires, qui seront utilisés dans les tests :
let (^) regexp1 regexp2 = Concat (regexp1, regexp2)
let (||) regexp1 regexp2 = Union (regexp1, regexp2)
let some_regexps =
[ (Letter 'a' || Epsilon) ^ Letter 'b';
Star (Letter 'a') ^ Star (Letter 'b');
Star (Letter 'b' ^ Star(Letter 'a') ^ Letter 'b');
Star Epsilon ^ Letter 'a' ^ Letter 'b';
]
Écrire une fonction comptant le nombre d'étoiles d'une expression régulière.
val count_kleene_stars : regular_expression -> int = <fun>
let tests_count_kleene_stars () =
assert (List.map count_kleene_stars some_regexps = [ 0; 2; 2; 1 ])
Solution :
let rec count_kleene_stars = function
| Epsilon
| Letter _ -> 0
| Concat (left_expr, right_expr)
| Union (left_expr, right_expr) ->
count_kleene_stars left_expr + count_kleene_stars right_expr
| 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 :
type length =
| Finite of int
| 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.
val max_length : length -> length -> length = <fun>
val add_length : length -> length -> length = <fun>
val length_of_longuest_word : regular_expression -> length = <fun>
let tests_length_longuest_word () =
assert (
List.map length_of_longuest_word some_regexps
= [ Finite 2; Infinite; Infinite; Finite 2 ]
)
Solution :
let lift_int_operator_to_length (++) length0 length1 =
match length0, length1 with
| Infinite,_
| _, Infinite -> Infinite
| Finite len0, Finite len1 -> Finite (len0 ++ len1)
let max_length = lift_int_operator_to_length max
let add_length = lift_int_operator_to_length (+)
let rec length_of_longuest_word = function
| Epsilon -> Finite 0
| Letter _ -> Finite 1
| Concat (left_expr, right_expr) ->
add_length
(length_of_longuest_word left_expr)
(length_of_longuest_word right_expr)
| Union (left_expr,right_expr) ->
max_length
(length_of_longuest_word left_expr)
(length_of_longuest_word right_expr)
| Star expr when length_of_longuest_word expr = Finite 0 ->
Finite 0
| 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.
val sum_of_even_elements : int list -> int = <fun>
let test_sum_of_even_elements () =
assert (
List.map sum_of_even_elements
[ [1;2;3;4;5;6;7;8];
[];
[2;4;6;8];
[7;5;3;1]
]
= [ 20; 0; 20; 0]
)
Solution :
let sum_of_even_elements integers =
integers
|> List.filter (fun i -> i mod 2 = 0)
|> List.fold_left (+) 0
Prénoms féminins.
Nous définissons les types suivants pour représenter les prénoms :
type gender =
| FemaleOnly
| MaleOnly
| Any
type first_name =
{ name : string;
gender : gender
}
É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.
val extract_first_names_suitable_for_female :
first_name list -> string list = <fun>
let test_extract_first_names_suitable_for_female =
assert (
extract_first_names_suitable_for_female
[ { name = "Camille"; gender = Any };
{ name = "Alphonse"; gender = MaleOnly };
{ name = "Diane"; gender = FemaleOnly };
{ name = "Gérard"; gender = MaleOnly };
{ name = "Sophie"; gender = FemaleOnly }
]
= ["Camille"; "Diane"; "Sophie"]
)
Solution :
let extract_first_names_suitable_for_female first_names =
first_names
|> List.filter (fun first_name -> first_name.gender <> MaleOnly)
|> 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).
val map2 : f:('a -> 'b -> 'c) -> 'a list -> 'b list -> 'c list = <fun>
let tests_map2 =
assert (map2 (+) [1;2;3] [40;50;20;30] = [41; 52; 23]);
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 :
let rec map2 ~f left_list right_list =
match left_list, right_list with
| [], _
| _, [] -> []
| left_head::left_tail, right_head::right_tail ->
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.
val pair_adjacent_items : 'a list -> ('a * 'a) list = <fun>
let test_pair_adjacent_items () =
assert (
pair_adjacent_items [1;3;4;6;2;5]
= [(1, 3); (3, 4); (4, 6); (6, 2); (2, 5)]
)
Solution :
let pair_adjacent_items list =
match list with
| [] -> []
| head::tail ->
map2 ~f:(fun previous next -> (previous,next))
list
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.
let rec drop n elements =
match elements with
| _ when n <= 0 -> elements
| first::others -> drop (n-1) others
| [] -> []
let a_evaluer_1 = drop 5 [3;4;5;6;7;8;9;10]
let rec move_head_to_last list =
match list with
| head :: second :: others ->
second :: move_head_to_last (head::others)
| _ -> list
let a_evaluer_2 = move_head_to_last [5;2;6;4;3;1]
let rec alternating_map ~f ~g list =
match list with
| head::tail -> f head :: alternating_map ~f:g ~g:f tail
| [] -> []
let a_evaluer_3 =
let double x = 2 * x in
let incr x = 1 + x in
alternating_map ~f:double ~g:incr [1;2;3;4;5;6]
let extend list =
let rec traverse prefix suffix =
match suffix with
| [] ->
[(prefix,[])]
| element::remains ->
(prefix,suffix) :: traverse (element::prefix) remains
in
traverse [] list
let a_evaluer_4 = extend [1;2;3;4]
Solution :
drop 5 [3;4;5;6;7;8;9;10]
--> drop 4 [4;5;6;7;8;9;10]
--> drop 3 [5;6;7;8;9;10]
--> drop 2 [6;7;8;9;10]
--> drop 1 [7;8;9;10]
--> drop 0 [8;9;10]
--> [8;9;10]
move_head_to_last [5;2;6;4;3;1]
--> 2 :: move_head_to_last [5;6;4;3;1]
--> 2 :: 6 :: move_head_to_last [5;4;3;1]
--> 2 :: 6 :: 4 :: move_head_to_last [5;3;1]
--> 2 :: 6 :: 4 :: 3 :: move_head_to_last [5;1]
--> 2 :: 6 :: 4 :: 3 :: 1 :: move_head_to_last [5]
--> [2; 6; 4; 3; 1; 5]
alternating_map ~f:double ~g:incr [1;2;3;4;5;6]
--> 2 :: alternating_map ~f:incr ~g:double [2;3;4;5;6]
--> 2 :: 3 :: alternating_map ~f:double ~g:incr [3;4;5;6]
--> 2 :: 3 :: 6 :: alternating_map ~f:incr ~g:double [4;5;6]
--> 2 :: 3 :: 6 :: 5 :: alternating_map ~f:double ~g:incr [5;6]
--> 2 :: 3 :: 6 :: 5 :: 10 :: alternating_map ~f:incr ~g:double [6]
--> 2 :: 3 :: 6 :: 5 :: 10 :: 7 :: alternating_map ~f:double ~g:incr []
--> [ 2; 3; 6; 5; 10; 7 ]
extend [1;2;3]
--> traverse [] [1;2;3]
--> ([],[1;2;3]) :: traverse [1] [2;3]
--> ([],[1;2;3]) :: ([1],[2;3]) :: traverse [2;1] [3]
--> ([],[1;2;3]) :: ([1],[2;3]) :: ([2;1],[3]) :: traverse [3;2;1] []
--> [ ([],[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 :
# let test_every_odd_int_is_prime =
Test.asserts Generator.int (fun i -> is_even i || is_prime i)
val test_every_odd_int_is_prime : Test.t = Test.Test (<abstr>, <fun>)
# let _ = Runner.run test_every_odd_int_is_prime
Failed: 57: Assertion failed
Failed: 87: Assertion failed
Failed: 69: Assertion failed
- : 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 :
Generator définit des fonctions pour décrire les générateurs aléatoires d'arguments pour les fonctions.
Test permet d'écrire les tests proprement dit.
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 :
module Generator : sig
type 'value t
val int : int t
val float : float t
val bool : bool t
val list : 'value t -> 'value list t
val return : description:string -> 'value -> 'value t
val bind : 'init t -> ('init -> 'value t) -> 'value t
val (>>=) : 'init t -> ('init -> 'value t) -> 'value t
type 'value argument
val get_value : 'value argument -> 'value
val get_description : 'value argument -> string
val run : 'value t -> 'value argument
end
Quelle interface usuelle contient Generator ? À quoi le reconnaissez-vous ?
Trouver un nom approprié pour l'expression suivante. Quel est son type ?
let nom_inadequat =
let open Generator in
int >>= fun i ->
int >>= fun j ->
return ~description:(Printf.sprintf "(%d,%d)" i j) (i,j)
Écrire une expression décrivant un argument de type float option.
É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 :
val option : 'arg t -> 'arg option t
Solution :
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.
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.
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.
let float_option_generator =
bool >>= fun is_none ->
if is_none then Generator.return ~description:"None"
else ...
Dans le deuxième cas, on génère en plus un flottant, et on retourne une option sur ce flottant.
let float_option_generator =
Generator.bool >>= fun is_none ->
if is_none then Generator.return ~description:"None"
else
Generator.float >>= fun value ->
let description = Printf.sprintf "Some %f" value in
Generator.return ~description (Some value)
Il suffit alors de généraliser le code précédant pour obtenir :
let option_generator value_generator=
Generator.bool >>= fun is_none ->
if is_none then Generator.return ~description:"None"
else
value_generator >>= fun value ->
let description = "an option" in
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.
module Test : sig
type result =
| Ok
| ErrorMessage of string
type t =
Test : 'value Generator.t * ('value Generator.argument -> result) -> t
val equals :
?compare:('result -> 'result -> int)
-> gen:('value Generator.t)
-> ('value -> 'result)
-> ('value -> 'result)
-> t
val asserts :
gen:('value Generator.t)
-> ('value -> bool)
-> t
end
Notez la syntaxe inhabituelle utilisée pour le type t. Quel erreur indiquerait le compilateur pour le type suivant ?
type t = Test of 'value Generator.t * ('value Generator.argument -> result)
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 :
val check_asserts : ('value -> bool) -> 'value Generator.argument -> result
de sorte que asserts soit définie par~:
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 :
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.
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.
let check_asserts fct gen_value =
let argument = Generator.run gen_value in
if fct (Generator.get_value argument) then OK
else
let description = Generator.get_description argument in
let msg = Printf.sprintf "%s: Assertion failed" description in
ErrorMessage msg
Écriture et exécution de tests
Le dernier module a pour interface :
module Runner : sig
val run : Test.t -> bool
end
Écrire un test pour vérifier que renverser deux fois une liste avec List.rev redonne la liste de départ.
Écrire un test pour vérifier que List.flatten conserve le nombre d'éléments des listes.
Écrire la fonction Runner.run.
Solution :
On écrit le générateur, en ouvrant localement {verb {:Generator:}}
cela donne un code assez lisible. D'autre part on écrit la fonction de
test. Ici le code est assez court, on peut se permettre de tout
laisser en un bloc.
Notons aussi que l'égalité de listes opère comme on le souhaite en OCaml.
let do_test_list_rev =
Runner.run
Test (
Generator.(list int),
(fun list -> List.(list |> rev |> rev) = list)
)
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.
let length_of_flattening list = List.(list |> flatten |> length) in
let length_of_list_list list =
List.(list |> map length |> fold_left (+) 0)
let do_test_flatten =
Runner.run
Test (
Generator.(list (list int)),
(fun list -> length_of_flattening list = length_of_list_list list)
)
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.
let run (Test (gen_value,test_fct)) =
let test_result = gen_value |> Generator.run |> test_fct in
match test_result with
| OK -> true
| ErrorMessage msg ->
Printf.printf "%s\n%!" msg;
false
Éléments de langage
Fonctions utiles de la librairie standard :
val max : 'a -> 'a -> 'a
val sqrt : float -> float
val ( ** ) : float -> float -> float
val (@) : 'a list -> 'a list -> 'a list
type 'elt option =
| Some of 'elt
| None
Fonctions utiles du module List :
val hd : 'elt list -> 'elt
val tl : 'elt list -> 'elt list
val length : 'a list -> int
val nth : 'a list -> int -> 'a
val rev : 'a list -> 'a list
val flatten : 'a list list -> 'a list
val map : ('a -> 'b) -> 'a list -> 'b list
val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
val for_all : ('a -> bool) -> 'a list -> bool
val exists : ('a -> bool) -> 'a list -> bool
val mem : 'a -> 'a list -> bool
val filter : ('a -> bool) -> 'a list -> 'a list
val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
Exemples de syntaxe :
type ratio = int * int
let rec euclid a b =
if b = 0 then a
else euclid b (a mod b)
let pgcd a b = euclid (abs a) (abs b)
let ratio p q =
let d = pgcd p q in
if q < 0 then (-p / d, q / d)
else (p/d, q/d)
let (+/) (a,b) (c,d) = ratio (a*d + b*c) (b*d)
let (++) (a,b) (c,d) = ratio (a+c) (b+d)
module IntMap = Map.Make(struct type t = int let compare = compare end)
module Queue =
struct
type 'a t =
Queue of ('a list) * ('a list)
exception Empty
let empty = Queue ([],[])
let is_empty = function
| Queue ([],[]) -> true
| _ -> false
let queue = function
| Queue ([],l) -> Queue(List.rev l,[])
| x -> x
let snoc (Queue (l1,l2)) ele =
queue (Queue (l1,ele::l2))
let head = function
| Queue ([],_) -> raise Empty
| Queue (l,_) -> List.hd l
let tail = function
| Queue ([],_) -> raise Empty
| Queue (l1,l2) -> queue (Queue (List.tl l1,l2))
end
