Callcc/Guyslain/Teaching/ProgFonc/examen2013

Version & licenses
Creative Commons License
  1. {`author "Guyslain Naves"}
  2. {`date "Mai 2013"}
  3. {`windowtitle "Programmation Fonctionnelle, Examen"}
  4. {`frametitle "Programmation Fonctionnelle, Examen"}
  5. {`menu "progfonc"}



  6. {section 4 Exercice 1 : Typage (5 points)}

  7. Donner le type de chacune des valeurs {verb {:f:}}, {verb {:g:}}, {verb {:h:}}, {verb {:a:}} et {verb {:b:}}.

  8. {code {`language "ocaml"} {:
  9. let f x y = ((x +. y) /. 2., sqrt (x *. y))

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

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

  12. let a lst =
  13. let f accu lst = match lst with
  14. | [] -> accu
  15. | head::_ -> head::accu
  16. in
  17. List.fold_left f [] lst

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


  20. {subframe {`boxed} {bold Solution : }

  21. - {subframe {verb {:x:}} et {verb {:y:}} sont tous deux flottants à cause de l'addition et de la multiplication. Le résultat est un couple de flottants, donc
  22. {code {`language "ocaml"} {:val f : float -> float -> float * float:}}
  23. }
  24. - {subframe D'abord, le type de {verb {:fun (x,y) -> (-x,y+1):}} est clairement {verb {:int * int -> int * int:}} à cause de l'addition et du moins unaire. Ensuite, on a {verb {:List.map : ('a -> 'b) -> 'a list -> 'b list:}}, donc en appliquant le premier argument on obtient :
  25. {code {`language "ocaml"} {:val g : (int * int) list -> (int * int) list :}}
  26. }
  27. - {subframe {verb {:f:}} est une fonction à (au moins) deux arguments, de même type puisqu'on l'applique avec {verb {:x:}} deux fois, et dont le résultat est de même type (puisqu'on le réapplique à {verb {:f:}}), donc {verb {:f : 'a -> 'a -> 'a:}}. On en déduit :
  28. {code {`language "ocaml"} {:val h : ('a -> 'a -> 'a) -> 'a -> 'a:}}
  29. }
  30. - {subframe On commence par trouver le type de la fonction auxiliaire {verb {:f:}}. L'utilisation du {verb {: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 {verb {:f : 'c list -> 'c list -> 'c list:}}. Par ailleurs, nous savons que {verb {:List.fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a:}}, donc {verb {:'a = 'b = 'c list:}} et :
  31. {code {`language "ocaml"} {:val a: 'a list list -> 'a list:}}
  32. }
  33. - {subframe Le premier argument de {verb {:List.map:}} est de type {verb {:'a list -> 'a:}} (deuxième motif) avec {verb {:'a = 'b list:}} (premier motif). Donc {verb {:lst : 'b list list list:}}, et :
  34. {code {`language "ocaml"} {:val b : 'b list list list -> 'b list list:}}
  35. }
  36. }


  37. {section 4 Exercice 2 : Manipulations de listes (5 points)}

  38. Implémenter les 5 fonctions suivantes.

  39. {code {`language "ocaml"} {:
  40. (* [sum_int_list] calcule la somme des entiers d'une liste d'entiers *)
  41. val sum_int_list : int list -> int

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

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

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

  52. (* [rotate lst k], avec [k] >= 0, repète [k] fois
  53. * l'opération de déplacer le premier élément de la liste à la fin
  54. *)
  55. val rotate : 'a list -> int -> 'a list
  56. (* rotate [1;2;3;4;5;6;7;8;9] 4 = [5; 6; 7; 8; 9; 1; 2; 3; 4]
  57. * rotate [1;2;3;4;5;6;7;8;9] 15 = [7; 8; 9; 1; 2; 3; 4; 5; 6]
  58. *)
  59. :}}

  60. {subframe {`boxed} {bold Solution : }

  61. {code {`language "ocaml"} {:
  62. let sum_int_list = List.fold_left (+) 0

  63. let rec even_position_only = function
  64. | odd::even::others -> even::(even_position_only others)
  65. | _ -> []

  66. let contains_42 = List.mem 42
  67. :}}

  68. 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 :

  69. {code {`language "ocaml"} {:
  70. (* Solution jolie mais fausse : *)
  71. let contains_a_42_pair lst = List.exists (fun elt -> List.mem (42 - elt) lst) lst
  72. :}}

  73. 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.

  74. {code {`language "ocaml"} {:
  75. (* Solution correcte (mais peu efficace) : *)
  76. let rec contains_a_42_pair = function
  77. | head::tail -> (List.mem (42 - head) tail) || contains_a_42_pair tail
  78. | [] -> false
  79. :}}

  80. 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)$.

  81. {code {`language "ocaml"} {:
  82. (* Une structure de dictionnaire d'entier *)
  83. module ISet = Set.Make(struct type t = int let compare = compare end)

  84. let contains_a_42_pair lst =
  85. snd
  86. (List.fold_left
  87. (fun (set,found_42) elt -> (ISet.add elt set, found_42 || ISet.mem (42 - elt) set))
  88. (ISet.empty,false)
  89. lst
  90. )
  91. :}}

  92. 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.

  93. {code {`language "ocaml"} {:
  94. let rec single_rotate (accu,list) =
  95. match list with
  96. | head::tail -> (head::accu,tail)
  97. | [] -> if accu = [] then ([],[]) else single_rotate ([],List.rev accu)


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

  99. let rotate list n =
  100. let (accu,suffix) = repeat single_rotate ([],list) n in
  101. suffix @ (List.rec accu)
  102. :}
  103. }

  104. }



  105. {section 4 Exercice 3 : Fonctionnelles (10 points)}

  106. On définit le type des arbres binaires ainsi :

  107. {code {`language "ocaml"} {:
  108. type 'a bintree =
  109. | Leaf
  110. | Node of 'a bintree * 'a * 'a bintree
  111. :}}
  112. Chaque nœud interne porte une information, d'un type arbitraire.

  113. + {subframe Donner une fonction calculant la hauteur d'un arbre binaire:
  114. {code {`language "ocaml"} {:
  115. val height : 'a bintree -> int
  116. :}}
  117. {subframe {`boxed} {bold Solution : }
  118. {code {`language "ocaml"} {:
  119. let rec height = function
  120. | Leaf -> -1
  121. | Node (left,_,right) -> 1 + max (height left) (height right)
  122. :}}

  123. }
  124. }
  125. + {subframe Écrire une fonction {verb {:map:}} pour les arbres, similaire à {verb {:List.map:}}.
  126. {code {`language "ocaml"} {:
  127. (* map : ('a -> 'b) -> 'a bintree -> 'b bintree *)
  128. # map (fun x -> x+1) (Node (Node (Leaf,3,Leaf),5,Leaf));;
  129. - : int bintree = Node (Node (Leaf, 4, Leaf), 6, Leaf)
  130. :}}
  131. {subframe {`boxed} {bold Solution : }
  132. {code {`language "ocaml"} {:
  133. let rec map f = function
  134. | Leaf -> Leaf
  135. | Node (left,elt,right) -> Node (map f left, f elt, map f right)
  136. :}}

  137. }
  138. }
  139. + {subframe Écrire une fonction {verb {:fold_infix:}}. Elle applique une fonction à toutes les informations de l'arbre, dans l'ordre infixe.
  140. {code {`language "ocaml"} {:
  141. (* val fold_infix : ('a -> 'b -> 'a) -> 'a -> 'b bintree -> 'a *)
  142. # fold_infix (fun l e -> e::l) []
  143. (Node (Node (Node (Leaf, 3, Leaf), 1, Node (Leaf, 5, Leaf)),
  144. 0,
  145. Node (Node (Leaf, 4, Leaf), 2, Node (Leaf, 6, Leaf)))
  146. );;
  147. - : int list = [6; 2; 4; 0; 5; 1; 3]
  148. :}}
  149. L'ordre infixe correspond à l'ordre {emph 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.

  150. {figure af://guyslain/images/Teaching/ProgFonc/infix-order.png {`height 300} {`tooltip "Numérotation infixe"} Exemple de numérotation infixe d'un arbre}

  151. {subframe {`boxed} {bold Solution : }
  152. {code {`language "ocaml"} {:
  153. let rec fold_infix f value = function
  154. | Leaf -> value
  155. | Node (left,elt,right) -> fold_infix f (f (fold_infix f value left) elt) right
  156. :}}
  157. }
  158. }
  159. + {subframe 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 :

  160. {figure af://guyslain/images/Teaching/ProgFonc/complete-binary.png {`height 300} {`tooltip "Arbre complet en numérotation infixe"} Arbre complet avec numérotation infixe.}

  161. 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 {verb {:index_tree:}} (vous utiliserez la fonction {verb {:map:}} définie plus tôt).
  162. {code {`language "ocaml"} {:
  163. (* val index_tree : int -> int bintree *)
  164. # index_tree 2;;
  165. - : int bintree =
  166. Node (Node (Node (Leaf, 1, Leaf), 2, Node (Leaf, 3, Leaf)),
  167. 4,
  168. Node (Node (Leaf, 5, Leaf), 6, Node (Leaf, 7, Leaf)))
  169. :}}

  170. {subframe {`boxed} {bold Solution : }
  171. {code {`language "ocaml"} {:
  172. let root = function
  173. | Leaf -> failwith "Invalid argument (root): tree must be non-empty"
  174. | Node (_,elt,_) -> elt

  175. let rec index_tree = function
  176. | 0 -> Leaf
  177. | 1 -> Node (Leaf,1,Leaf)
  178. | n ->
  179. let left = index_tree (n-1) in
  180. let top = 2 * root left in
  181. let right = map (fun x -> x + top) left in
  182. Node (left,top,right)
  183. :}}
  184. }
  185. }
  186. + {subframe (Difficile) Écrire maintenant une autre fonction {verb {: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.

  187. {figure af://guyslain/images/Teaching/ProgFonc/level-order.png {`tooltip "Ordre de profondeur"} Exemple d'arbre numéroter par profondeur croissante.}

  188. {code {`language "ocaml"} {:
  189. (* val fold : ('a -> 'b -> 'a) -> 'a -> 'b bintree -> 'a *)
  190. # fold (fun l e -> e::l) []
  191. (Node (Node (Node (Leaf, 1, Leaf), 2, Node (Leaf, 3, Leaf)),
  192. 4,
  193. Node (Node (Leaf, 5, Leaf), 6, Node (Leaf, 7, Leaf))
  194. ));;
  195. - : int list = [7; 5; 3; 1; 6; 2; 4]:}}

  196. {subframe {`boxed} {bold Solution : }
  197. 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.

  198. {code {`language "ocaml"} {:
  199. let rec fold_by_level f init tree_queue =
  200. match tree_queue with
  201. | [] -> init
  202. | Leaf::queue -> fold_by_level f init queue
  203. | (Node (left,a,right))::queue -> fold_by_level f (f init a) (queue@[left;right])
  204. :}}

  205. 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 {link af://callcc/Guyslain/Teaching/ProgFonc/TD4 TD4} (donnée en fin d'énoncé) pour obtenir une meilleure complexité.
  206. }
  207. }



  208. {section 4 Éléments de langage}

  209. Fonctions utiles de la librairie standard :

  210. {code {`language "ocaml"} {:
  211. val max : 'a -> 'a -> 'a (* calcule le maximum de deux valeurs *)
  212. val sqrt : float -> float (* calcule la racine carrée d'un nombre flottant *)
  213. val ( ** ) : float -> float -> float (* a ** b = a puissance b *)
  214. val (@) : 'a list -> 'a list -> 'a list (* concaténation de deux listes *)
  215. :}}

  216. Fonctions utiles du module List :

  217. {code {`language "ocaml"} {:
  218. val length : 'a list -> int
  219. val nth : 'a list -> int -> 'a
  220. val rev : 'a list -> 'a list
  221. val flatten : 'a list list -> 'a list
  222. val map : ('a -> 'b) -> 'a list -> 'b list
  223. val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b list -> 'a
  224. val fold_right : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b
  225. val for_all : ('a -> bool) -> 'a list -> bool
  226. val exists : ('a -> bool) -> 'a list -> bool
  227. val mem : 'a -> 'a list -> bool
  228. val filter : ('a -> bool) -> 'a list -> 'a list
  229. val fast_sort : ('a -> 'a -> int) -> 'a list -> 'a list
  230. :}}

  231. Exemples de syntaxe :

  232. {code {`language "ocaml"} {:
  233. type ratio = int * int

  234. let rec euclid a b =
  235. if b = 0 then a
  236. else euclid b (a mod b)

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

  238. let ratio p q =
  239. let d = pgcd p q in
  240. if q < 0 then (-p / d, q / d)
  241. else (p/d, q/d)

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

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

  244. module Queue =
  245. struct

  246. type 'a t =
  247. Queue of ('a list) * ('a list)

  248. exception Empty

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

  250. let is_empty = function
  251. | Queue ([],[]) -> true
  252. | _ -> false

  253. let queue = function
  254. | Queue ([],l) -> Queue(List.rev l,[])
  255. | x -> x

  256. let snoc (Queue (l1,l2)) ele =
  257. queue (Queue (l1,ele::l2))

  258. let head = function
  259. | Queue ([],_) -> raise Empty
  260. | Queue (l,_) -> List.hd l

  261. let tail = function
  262. | Queue ([],_) -> raise Empty
  263. | Queue (l1,l2) -> queue (Queue (List.tl l1,l2))

  264. end

  265. :}}