Programmation Fonctionnelle, TP4

Version & licenses
Creative Commons License

Programmation Fonctionnelle, TP4 : le compte est bon.

Guyslain Naves

Nous apprenons à utiliser les modules Map et Set. Ce faisant, nous allons écrire un algorithme résolvant le problème du compte est bon, faisant parti du célèbre jeu télévisé Des chiffres et des lettres.

Question 1 : Modules sur les entiers

  • Définir le module de type Set.OrderedType sur les entier :

    1. module Int :
    2. sig
    3. type t = int
    4. val compare : int -> int -> int
    5. end
  • Utiliser le foncteur Map.Make pour obtenir un module des applications partielles (map) d'entiers IMap.
  • Définir une fonction de comparaison sur les listes. On utilisera pour cela l'ordre total suivant : $[e_1;e_2;\ldots e_n] < [f_1;f_2;\ldots;f_p]$ si :
    • il existe $1 \leq i \leq n$ tel que $e_i < f_i$ et pour tout $1 \leq j < i$, $e_j = f_j$,
    • ou bien $p>n$ et $e_i = f_i$ pour tout $1 \leq i \leq n$.
  • En déduire un module d'application partielle sur les listes d'entiers.

Question 2 : Un peu de combinatoire

  • Nous allons avoir besoin d'énumérer toutes les sous-listes d'une liste d'entiers, et de faire des opérations dessus. Une sous-liste de $l$ est une liste d'éléments de $l$ apparaissant dans le même ordre (mais pas nécessairement consécutivement).

    1. (* exemple *)
    2. let sl = sublists [1;2;3;4];;
    3. val sl : int list list =
    4. [[]; [4]; [3]; [3; 4]; [2]; [2; 4]; [2; 3]; [2; 3; 4]; [1]; [1; 4];
    5. [1; 3]; [1; 3; 4]; [1; 2]; [1; 2; 4]; [1; 2; 3]; [1; 2; 3; 4]]

    Coder la fonction sublists correspondante, en utilisant une récurrence. On s'assurera que :

    1. les éléments apparaissent toujours dans le même ordre dans les sous-listes,
    2. la liste obtenu respecte l'ordre d'inclusion : si $l'$ est une sous-liste de $l''$, $l'$ apparait avant $l''$.
  • Nous aurons aussi besoin d'énumérer les partitions d'une liste en deux sous-listes (une bipartition). On utilise à nouveau une définition récursive. Toute bipartition d'une liste non-vide s'obtient en ajoutant la tête à une des deux parties d'une bipartition de la queue.

    1. let bp = bipartitions [1;2;3;4];;
    2. val bp : (int list * int list) list =
    3. [([1; 2; 3; 4], []); ([2; 3; 4], [1]); ([1; 3; 4], [2]); ([3; 4], [1; 2]);
    4. ([1; 2; 4], [3]); ([2; 4], [1; 3]); ([1; 4], [2; 3]); ([4], [1; 2; 3]);
    5. ([1; 2; 3], [4]); ([2; 3], [1; 4]); ([1; 3], [2; 4]); ([3], [1; 2; 4]);
    6. ([1; 2], [3; 4]); ([2], [1; 3; 4]); ([1], [2; 3; 4]); ([], [1; 2; 3; 4])]

    Coder la fonction bipartitions.

  • Enfin, nous utiliserons une fonction qui prend deux applications partielles $f$ et $g$ sur les entiers, et énumère toutes les paires $(f(i),g(j))$ pour $i$ et $j$ tels que $f(i)$ et $g(j)$ soient définies. Vous utiliserez deux IMap.fold imbriqués.
  1. val all_pairs : 'a IMap.t -> 'b IMap.t -> ('a * 'b) list

Question 3 : Opérateurs

Dans le jeu le compte est bon, seules quatre opérations arithmétiques sont autorisés : addition, soustraction, produit et division entière exacte (on ne peut diviser que si le reste est $0$). De plus, les résultats négatifs ou nuls sont interdits.

On définit le type algébrique :

  1. type operator =
  2. | Plus
  3. | Minus
  4. | Prod
  5. | Div
  • Donner une fonction qui à chaque opérateur, associe la fonction arithmétique qui lui correspond.
  • Donner une fonction qui à chaque opérateur lui associe son score entier : 20 pour l'addition, 40 pour la soustraction, 50 pour la multiplication et 100 pour la division.

Question 4 : Expressions arithmétiques

  • Une expression arithmétique est soit un litéral entier, soit un opérateur appliqué à deux autres expressions arithmétiques. Définir le type des expressions arithmétiques expr.
  • Donner une fonction eval qui calcule la valeur d'une expression arithmétique.
  • Donner une fonction score calculant le score d'une expression arithmétique : le score d'une expression est la somme des valeurs de ses litéraux et des scores des opérateurs qui la composent. Ainsi plus une expressions est complexe, plus son score sera élevé.
  • Donner une fonction valid_combination op a b qui prend un opérateur op et deux expressions arithmétiques, et qui décide si cet opérateur peut être appliqué à $a$ et $b$. Il s'agit par exemple de vérifier que les divisions sont entières ou que les soustractions donnent des valeurs positives.

    1. # valid_combination Div (Literal 12) (Literal 5);;
    2. - : bool = false
  • En déduire une fonction qui prenant deux expressions, calcule toutes les expressions valides pouvant être construites à partir de ces deux expressions en utilisant un opérateur.

    1. val combine : expr -> expr -> expr list = <fun>

Question 5 : Écriture d'une expression arithmétique

  • Écrire une fonction qui associe à chaque opérateur une chaine de caractère représentant l'opérateur en question.
  • Écrire une fonction transformant une expression arithmétique en chaine de caractères, par exemple "100 * 10 - (10 - 1) * 9 * 4". Attention aux parenthèses !

Question 6 : Ajout d'une expression à un ensemble de solutions.

À chaque liste $l$ d'entiers, on associe une application partielle (de type expr IMap.t), qui associe à chaque entier $n$ de son domaine une expression arithmétique de valeur $n$ utilisant seulement les litéraux de $l$. Nous allons avoir besoin d'une fonction qui ajoute une expression arithmétique à une telle application partielle. Écrire la fonction expr_imap_add expr map qui prend une expression arithmétique et une map, et qui ajoute expr dans map à l'indice eval e si cet indice n'existe pas encore, ou sinon, si l'expression arithmétique déjà associé à cet indice a un score plus élevé que e.

  1. val expr_imap_add : expr -> expr IMap.t -> expr IMap.t

Question 7 : Résolution générale, version naïve.

Le principe de l'algorithme est le suivant. Étant donné une liste d'entiers $l$ avec au moins 2 éléments (sinon c'est facile), on calcule toutes les bipartitions de cette liste. Pour chaque bipartition, on calcule récursivement les solutions pour les deux parties (on obtient deux maps), puis en utilisant all_pairs et combine, on génère toutes les expressions arithmétiques pour cette bipartition. Chaque expression pour chaque bipartition est ajoutée avec expr_imap_add à une application partielle codant la solution pour $l$.

Écrire l'algorithme correspondant. Le tester.

La suite du TP est optionnelle.

Un peu de théorie.

Examiner le code suivant.

  1. let fib0 fib = function
  2. | 0
  3. | 1 -> 1
  4. | n -> fib (n-1) + fib (n-2)

  5. let rec fib_naive i = fib0 fib_naive i

On définit avec fib0 la suite de Fibonacci, en prenant en argument la fonction à appeler récursivement. Nous n'avons rien perdu, puisqu'il suffit de dire que l'appel récursif doit utiliser fib0 pour retrouver la version naïve standard, ce qui est fait dans un deuxième temps avec fib_naive.

Nous savons aussi par les cours sur la programmation dynamique que tout va plus vite si on calcule la suite en partant des petites valeurs, d'abord $0$, puis $1$, $2$, … jusqu'à $n$. Je définis donc :

  1. let rec interval a b = if a > b then [] else a::(interval (a+1) b)

pour ensuite calculer la suite dans le bon sens :

  1. let better_fib n =
  2. let map =
  3. List.fold_left
  4. (fun map i -> IMap.add i (fib0 (fun j -> IMap.find j map) i) map)
  5. IMap.empty
  6. (interval 0 n)
  7. in IMap.find n map

Je calcule les valeurs de ma suite et les stocke dans map, dans le bon sens. Du coup, pour l'appel récursif, il me suffit de consulter les valeurs déjà calculées.

Plus généralement, je peux donner le foncteur suivant:

  1. module DynamicProg = functor (M : Map.S) ->
  2. struct
  3. let memoize enumeration induction instance =
  4. let map =
  5. List.fold_left
  6. (fun map sub_instance ->
  7. M.add
  8. sub_instance
  9. (induction (fun sub_sub_instance -> M.find sub_sub_instance map) sub_instance)
  10. map
  11. )
  12. M.empty
  13. enumeration
  14. in
  15. M.find instance map
  16. end

Le foncteur prend un module de type Map.S qui permet de stocker les solutions calculées de chaque instance. La fonction memoize prend en premier argument la liste des valeurs à calculer, dans l'ordre adéquat pour la programmation dynamique. Son second argument est la fonction calculant une étape d'induction, telle que fib0, cette fonction doit prendre en argument la fonction pour les appels récursifs. Enfin elle prend l'instance que l'on cherche à résoudre (un entier $n$ pour Fibonacci, pour lequel on veut calculer $F(n)$).

Reprendre et comprendre ce code. Utiliser le foncteur pour écrire Fibonacci.

Question 8 : Résolution générale, version programmation dynamique

Utiliser le foncteur DynamicProg pour améliorer l'algorithme de résolution du compte est bon.

Question 9 : Générer une instance aléatoirement

Une instance est composée d'un objectif et de six entiers choisis parmi la liste

$$[ 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 25; 50; 75; 100]$$

L'objectif est un entier entre 100 et 999, tiré uniformément aléatoirement.

Utiliser le module Random pour générer des instances aléatoires.

Question 10 : Conclure et compiler

Ajouter le code suivant (en renommant les variables libres au besoin) :

  1. let nearest imap goal = (* cherche la solution la plus proche de l'objectif *)
  2. if IMap.mem goal imap then goal
  3. else
  4. IMap.fold (fun j _ best -> if abs (goal - j) < abs (goal - best) then j else best) imap 0

  5. let main =
  6. let to_int string = (* tente de convertir une chaine en entier *)
  7. try [int_of_string string]
  8. with _ -> []
  9. in
  10. let print_expr goal expr = Printf.printf "%i = %s\n" goal (str_of_expr expr) in
  11. let int_args = List.flatten (List.map to_int (List.tl (Array.to_list Sys.argv))) in
  12. (* la liste des entiers en argument *)
  13. let array_exists p = Array.fold_left (fun b elt -> b || p elt) false in

  14. if array_exists (fun str -> str = "-a") Sys.argv then
  15. (* option -a : écrire toutes les solutions possibles *)
  16. IMap.iter print_expr (countdown_dp (List.fast_sort compare int_args))
  17. else if array_exists (fun str -> str = "-q") Sys.argv then
  18. (* option -q : proposer une instance, attendre 30s., donner la solution *)
  19. begin
  20. let (multiset,goal) = random_instance () in
  21. let solutions = countdown_dp multiset in
  22. Printf.printf "Try to find %i using only: [%s]\n" goal
  23. (String.concat "; " (List.map string_of_int multiset));
  24. flush stdout;
  25. Unix.sleep 30;
  26. let nearest_value = nearest solutions goal in
  27. Printf.printf "Best solution found:\n";
  28. print_expr nearest_value (IMap.find nearest_value solutions)
  29. end
  30. else
  31. (* sinon, lire les valeurs en arguments, la première est l'objectif *)
  32. (* et trouver une solution exacte *)
  33. match int_args with
  34. | goal::multiset ->
  35. let solutions = countdown_dp (List.fast_sort compare multiset) in
  36. if IMap.mem goal solutions then print_expr goal (IMap.find goal solutions)
  37. else Printf.printf "No solutions.\n"
  38. | _ -> Printf.printf "Invalid number of arguments: \
  39. I expect the goal, then a multisets of integer.\n"

Compiler, en ajoutant <nom_du_fichier.{byte,native}>: use_unix dans le fichier _tags.

Vous pouvez ensuite tenter d'améliorer le programme. Par exemple :

  • réduire au minimum nécessaire le nombre de parenthèses affichées lors de l'écriture d'une expression arithmétique,
  • réduire le nombre d'expressions arithmétiques calculées, en supprimant certaines symmétrie, comme $a + b = b + a$ ou $a + (b + c) = (a + b) + c$.