Programmation Fonctionnelle, Examen

Version & licenses
Creative Commons License

Programmation Fonctionnelle, Examen

Guyslain Naves

Exercice 1 : Typage (5 points)

Donner le type de chacune des valeurs f, g, h, a et b.

  1. let f x y = ((x +. y) /. 2., sqrt (x *. y))

  2. let g = List.map (fun (x,y) -> (-x,y+1))

  3. let h f x = f (f x x) x

  4. let a lst =
  5. let f accu lst = match lst with
  6. | [] -> accu
  7. | head::_ -> head::accu
  8. in
  9. List.fold_left f [] lst

  10. let b lst = List.rev (List.map (function [] -> [] | head::_ -> head) lst)

Solution :

  • x et y sont tous deux flottants à cause de l'addition et de la multiplication. Le résultat est un couple de flottants, donc

    1. val f : float -> float -> float * float
  • D'abord, le type de fun (x,y) -> (-x,y+1) est clairement int * int -> int * int à cause de l'addition et du moins unaire. Ensuite, on a List.map : ('a -> 'b) -> 'a list -> 'b list, donc en appliquant le premier argument on obtient :

    1. val g : (int * int) list -> (int * int) list
  • f est une fonction à (au moins) deux arguments, de même type puisqu'on l'applique avec x deux fois, et dont le résultat est de même type (puisqu'on le réapplique à f), donc f : 'a -> 'a -> 'a. On en déduit :

    1. val h : ('a -> 'a -> 'a) -> 'a -> 'a
  • On commence par trouver le type de la fonction auxiliaire f. L'utilisation du match indique que son deuxième argument. L'expression pour le deuxième motif nous dit que le premier argument est une liste du même type, donc f : 'c list -> 'c list -> 'c list. Par ailleurs, nous savons que List.fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a, donc 'a = 'b = 'c list et :

    1. val a: 'a list list -> 'a list
  • Le premier argument de List.map est de type 'a list -> 'a (deuxième motif) avec 'a = 'b list (premier motif). Donc lst : 'b list list list, et :

    1. val b : 'b list list list -> 'b list list

Exercice 2 : Manipulations de listes (5 points)

Implémenter les 5 fonctions suivantes.

  1. (* [sum_int_list] calcule la somme des entiers d'une liste d'entiers *)
  2. val sum_int_list : int list -> int

  3. (* [even_position_only lst] garde seulement les 2e, 4e, ... éléments de la liste [lst] *)
  4. val even_position_only : 'a list -> 'a list
  5. (* even_position_only ['a';'b';'c';'d';'e';'f';'g'] = ['b';'d';'f'] *)

  6. (* [contains_42] décide si la liste contient l'entier 42 *)
  7. val contains_42 : int list -> bool

  8. (* [contains_a_42_pair] décide si la liste contient deux entiers dont la somme vaut 42 *)
  9. val contains_a_42_pair : int list -> bool
  10. (* contains_a_42_pair [11;12;15;21] = false
  11. * contains_a_42_pair [13;17;20;25;33] = true (parce que 17+25=42)
  12. *)

  13. (* [rotate lst k], avec [k] >= 0, repète [k] fois
  14. * l'opération de déplacer le premier élément de la liste à la fin
  15. *)
  16. val rotate : 'a list -> int -> 'a list
  17. (* rotate [1;2;3;4;5;6;7;8;9] 4 = [5; 6; 7; 8; 9; 1; 2; 3; 4]
  18. * rotate [1;2;3;4;5;6;7;8;9] 15 = [7; 8; 9; 1; 2; 3; 4; 5; 6]
  19. *)

Solution :

  1. let sum_int_list = List.fold_left (+) 0

  2. let rec even_position_only = function
  3. | odd::even::others -> even::(even_position_only others)
  4. | _ -> []

  5. let contains_42 = List.mem 42

Les deux autres exercices sont plus subtils. Le premier consiste à décider s'il existe deux entiers de la liste dont la somme vaut 42. Une solution semble particulièrement simple :

  1. (* Solution jolie mais fausse : *)
  2. let contains_a_42_pair lst = List.exists (fun elt -> List.mem (42 - elt) lst) lst

car si 21 est présent en un seul exemplaire, l'algorithme répond oui en formant la paire 21 + 21 qui n'est pas valide. Une solution est de parcourir la liste, et pour chaque élément tenter de l'apparier avec un élément placé après dans la liste.

  1. (* Solution correcte (mais peu efficace) : *)
  2. let rec contains_a_42_pair = function
  3. | head::tail -> (List.mem (42 - head) tail) || contains_a_42_pair tail
  4. | [] -> false

Cette solution est correcte (et est la solution attendue), mais de complexité $O(n^2)$ si $n$ est la longueur de la liste. Avec un peu d'algorithmique, on peut faire mieux. On parcourt la liste de gauche à droite, en insérant les entiers dans un dictionnaire. À chaque étape on vérifie si on peut faire une paire avec l'élément courant et un entier du dictionnaire, ce qui donne une complexité de $O(n \log n)$.

  1. (* Une structure de dictionnaire d'entier *)
  2. module ISet = Set.Make(struct type t = int let compare = compare end)

  3. let contains_a_42_pair lst =
  4. snd
  5. (List.fold_left
  6. (fun (set,found_42) elt -> (ISet.add elt set, found_42 || ISet.mem (42 - elt) set))
  7. (ISet.empty,false)
  8. lst
  9. )

On décompose le dernier exercice comme suit. D'abord on écrit une fonction pour faire une seule rotation. Puis on écrit une fonctionnelle pour répéter une fonction plusieurs fois, qu'on utilise avec la première fonction pour résoudre l'exercice. Pour la rotation simple, comme il n'est pas très efficace de concaténer un élément en fin de liste, on garde un accumulateur, qui servira à stocker la fin de la liste en ordre inverse.

  1. let rec single_rotate (accu,list) =
  2. match list with
  3. | head::tail -> (head::accu,tail)
  4. | [] -> if accu = [] then ([],[]) else single_rotate ([],List.rev accu)


  5. let repeat f value k = if k = 0 then value else repeat f (f value) (k-1)

  6. let rotate list n =
  7. let (accu,suffix) = repeat single_rotate ([],list) n in
  8. suffix @ (List.rec accu)

Exercice 3 : Fonctionnelles (10 points)

On définit le type des arbres binaires ainsi :

  1. type 'a bintree =
  2. | Leaf
  3. | Node of 'a bintree * 'a * 'a bintree

Chaque nœud interne porte une information, d'un type arbitraire.

  1. Donner une fonction calculant la hauteur d'un arbre binaire:

    1. val height : 'a bintree -> int

    Solution :

    1. let rec height = function
    2. | Leaf -> -1
    3. | Node (left,_,right) -> 1 + max (height left) (height right)
  2. Écrire une fonction map pour les arbres, similaire à List.map.

    1. (* map : ('a -> 'b) -> 'a bintree -> 'b bintree *)
    2. # map (fun x -> x+1) (Node (Node (Leaf,3,Leaf),5,Leaf));;
    3. - : int bintree = Node (Node (Leaf, 4, Leaf), 6, Leaf)

    Solution :

    1. let rec map f = function
    2. | Leaf -> Leaf
    3. | Node (left,elt,right) -> Node (map f left, f elt, map f right)
  3. Écrire une fonction fold_infix. Elle applique une fonction à toutes les informations de l'arbre, dans l'ordre infixe.

    1. (* val fold_infix : ('a -> 'b -> 'a) -> 'a -> 'b bintree -> 'a *)
    2. # fold_infix (fun l e -> e::l) []
    3. (Node (Node (Node (Leaf, 3, Leaf), 1, Node (Leaf, 5, Leaf)),
    4. 0,
    5. Node (Node (Leaf, 4, Leaf), 2, Node (Leaf, 6, Leaf)))
    6. );;
    7. - : int list = [6; 2; 4; 0; 5; 1; 3]

    L'ordre infixe correspond à l'ordre de gauche à droite, et est illustré par la figure suivante pour laquelle les nœuds sont numérotés en ordre infixe. On doit donc appliquer la fonction d'abord aux nœuds du fils gauche de la racine, puis à la racine elle-même, puis aux nœuds du fils droit.

    Exemple de numérotation infixe d'un arbre

    Solution :

    1. let rec fold_infix f value = function
    2. | Leaf -> value
    3. | Node (left,elt,right) -> fold_infix f (f (fold_infix f value left) elt) right
  4. Nous souhaitons maintenant construire un arbre binaire complet de hauteur $h$, dont les informations sont les entiers de $1$ à $2^{h+1}-1$, en ordre infixe, tel que dans la figure suivante :

    Arbre complet avec numérotation infixe.

    Nous procédons par récurrence. Le fils gauche de l'arbre de hauteur $d$ s'obtient par récurrence, et le fils droit s'obtient à partir du fils gauche par une opération arithmétique élémentaire. En déduire la fonction index_tree (vous utiliserez la fonction map définie plus tôt).

    1. (* val index_tree : int -> int bintree *)
    2. # index_tree 2;;
    3. - : int bintree =
    4. Node (Node (Node (Leaf, 1, Leaf), 2, Node (Leaf, 3, Leaf)),
    5. 4,
    6. Node (Node (Leaf, 5, Leaf), 6, Node (Leaf, 7, Leaf)))

    Solution :

    1. let root = function
    2. | Leaf -> failwith "Invalid argument (root): tree must be non-empty"
    3. | Node (_,elt,_) -> elt

    4. let rec index_tree = function
    5. | 0 -> Leaf
    6. | 1 -> Node (Leaf,1,Leaf)
    7. | n ->
    8. let left = index_tree (n-1) in
    9. let top = 2 * root left in
    10. let right = map (fun x -> x + top) left in
    11. Node (left,top,right)
  5. (Difficile) Écrire maintenant une autre fonction fold, qui folde maintenant par ordre de profondeur, de haut en bas puis de gauche à droite, ce qui correspond à l'ordre indiqué dans la figure suivante.

    Exemple d'arbre numéroter par profondeur croissante.
    1. (* val fold : ('a -> 'b -> 'a) -> 'a -> 'b bintree -> 'a *)
    2. # fold (fun l e -> e::l) []
    3. (Node (Node (Node (Leaf, 1, Leaf), 2, Node (Leaf, 3, Leaf)),
    4. 4,
    5. Node (Node (Leaf, 5, Leaf), 6, Node (Leaf, 7, Leaf))
    6. ));;
    7. - : int list = [7; 5; 3; 1; 6; 2; 4]

    Solution :Il s'agit de faire un parcours en largeur de l'arbre depuis la racine, donc nous allons avoir besoin d'une structure de file FIFO. À chaque fois que nous examinons un nœud, on ajoute en fin de file ses deux fils. Puis on lit l'élément en tête de file. On répète tant que la file n'est pas vide.

    1. let rec fold_by_level f init tree_queue =
    2. match tree_queue with
    3. | [] -> init
    4. | Leaf::queue -> fold_by_level f init queue
    5. | (Node (left,a,right))::queue -> fold_by_level f (f init a) (queue@[left;right])

    Ici on a utilisé une file codée avec une simple liste, ce qui rend l'insertion peu efficace. On pourrait facilement réutiliser la structure de file du TD4 (donnée en fin d'énoncé) pour obtenir une meilleure complexité.

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

Fonctions utiles du module List :

  1. val length : 'a list -> int
  2. val nth : 'a list -> int -> 'a
  3. val rev : 'a list -> 'a list
  4. val flatten : 'a list list -> 'a list
  5. val map : ('a -> 'b) -> 'a list -> 'b list
  6. val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
  7. val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
  8. val for_all : ('a -> bool) -> 'a list -> bool
  9. val exists : ('a -> bool) -> 'a list -> bool
  10. val mem : 'a -> 'a list -> bool
  11. val filter : ('a -> bool) -> 'a list -> 'a list
  12. val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list

Exemples de syntaxe :

  1. type ratio = int * int

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

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

  6. let ratio p q =
  7. let d = pgcd p q in
  8. if q < 0 then (-p / d, q / d)
  9. else (p/d, q/d)

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

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

  12. module Queue =
  13. struct

  14. type 'a t =
  15. Queue of ('a list) * ('a list)

  16. exception Empty

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

  18. let is_empty = function
  19. | Queue ([],[]) -> true
  20. | _ -> false

  21. let queue = function
  22. | Queue ([],l) -> Queue(List.rev l,[])
  23. | x -> x

  24. let snoc (Queue (l1,l2)) ele =
  25. queue (Queue (l1,ele::l2))

  26. let head = function
  27. | Queue ([],_) -> raise Empty
  28. | Queue (l,_) -> List.hd l

  29. let tail = function
  30. | Queue ([],_) -> raise Empty
  31. | Queue (l1,l2) -> queue (Queue (List.tl l1,l2))

  32. end