Programmation Fonctionnelle, TP5

Figure
Version & licenses
Creative Commons License

Programmation Fonctionnelle, TP5 : dessin d'arbres binaires.

Guyslain Naves

Dans ce TP, nous définissons et manipulons des arbres binaires et écrivons des algorithmes simples pour les dessiner. La semaine prochaine, nous verrons un algorithme plus complexe pour obtenir des dessins de qualité pour les arbres binaires, nous réutiliserons donc le programme de cette semaine.

Vous pouvez utiliser Core (ou Base) pour les modules List et Option. On utilisera Gg et Vg pour dessiner les arbres, QCheck pour tester. Créez les fichiers .merlin et _tags pour cela.

Types des arbres binaires.

Recopiez ce type algébrique pour représenter les arbres binaires, paramêtré par le type de l'information associée à chaque nœud. On définit aussi un générateur aléatoire d'arbres binaires, de sorte à pouvoir utiliser QCheck pour tester les fonctions d'arbres. Il est paramétré par le type des nœuds, on fournit aussi deux générateurs pour des arbres avec des nœuds entiers ou des nœuds sans information.

En terme d'organisation, on fera :

  • un fichier pour le type des arbres, qui contiendra les fonctions construisant des arbres particuliers et les fonctions permettant de manipuler les arbres. On exporte le type des arbres sans l'abstraire (le fichier mli doit donc contenir la définition complète du type des arbres).
  • Un fichier (et son mli contenant les arbitraires d'arbres.
  • Un fichier contenant les tests.
  • plus tard on ajoutera des fichiers pour l'algorithme de dessin d'arbres.

Aujourd'hui, dans le but d'acquérir plus d'autonomie, vous créez tous les fichiers vous-mêmes, et reportant chaque morceau du programme dans le fichier adéquat.

  1. (* copy this in binTree.ml and binTree.mli *)
  2. type 'elt t =
  3. | Leaf
  4. | Node of 'elt t * 'elt * 'elt t


  5. module Arbitrary : sig

  6. (* this goes into arbitraryTree.mli (open BinTree) *)

  7. (* #install_printer Arbitrary.pp
  8. to allow the toplevel to display trees
  9. *)
  10. val pp :
  11. (Format.formatter -> 'elt -> unit)
  12. -> Format.formatter -> 'elt t -> unit

  13. val tree : 'elt QCheck.arbitrary -> 'elt t QCheck.arbitrary

  14. val int_tree : int t QCheck.arbitrary
  15. val unit_tree : unit t QCheck.arbitrary

  16. end = struct

  17. (* this goes into arbitraryTree.ml *)

  18. let rec pp elt_pp formatter = function
  19. | Leaf ->
  20. Format.fprintf formatter "Leaf"
  21. | Node (left,root,right) ->
  22. Format.fprintf formatter
  23. "@[<hv 2>Node (@;@[<hv>%a,@;%a,@;%a@]@;)@]"
  24. (pp elt_pp) left
  25. elt_pp root
  26. (pp elt_pp) right

  27. let print : 'elt QCheck.Print.t -> 'elt t QCheck.Print.t =
  28. fun elt_print tree ->
  29. let open Format in
  30. let elt_pp formatter elt =
  31. fprintf formatter "%s" (elt_print elt)
  32. in
  33. asprintf "%a" (pp elt_pp) tree


  34. let rec shrink : 'elt QCheck.Shrink.t -> 'elt t QCheck.Shrink.t =
  35. fun elt_shrink ->
  36. let open QCheck.Iter in
  37. function
  38. | Leaf -> empty
  39. | Node (left,root,right) ->
  40. of_list [ left; right ]
  41. <+> (shrink elt_shrink left
  42. >|= fun left_red -> Node (left_red,root,right))
  43. <+> (shrink elt_shrink right
  44. >|= fun right_red -> Node (left,root,right_red))
  45. <+> (elt_shrink root
  46. >|= fun root_red -> Node (left,root_red,right))


  47. let rec tree_gen : 'elt QCheck.Gen.t -> int -> 'elt t QCheck.Gen.t =
  48. fun elt_gen size ->
  49. let open QCheck.Gen in
  50. if size <= 0 then return Leaf
  51. else
  52. 0 -- (size-1) >>= fun size_left ->
  53. let size_right = size - size_left - 1 in
  54. tree_gen elt_gen size_left >>= fun left ->
  55. tree_gen elt_gen size_right >>= fun right ->
  56. elt_gen >>= fun root ->
  57. return (Node (left,root,right))


  58. let tree : 'elt QCheck.arbitrary -> 'elt t QCheck.arbitrary =
  59. fun elt_arbitrary ->
  60. let open QCheck in
  61. QCheck.make
  62. ?print:Option.(elt_arbitrary.print >>| print)
  63. ?shrink:Option.(elt_arbitrary.shrink >>| shrink)
  64. (Gen.sized (tree_gen elt_arbitrary.gen))

  65. let int_tree = tree QCheck.small_int
  66. let unit_tree = tree QCheck.unit

  67. end


  68. (* This goes into checkBinTree.ml *)

  69. let perform_test ((QCheck.Test.Test cell) as test) =
  70. Printf.printf "Next test: %s\n%!" (QCheck.Test.get_name cell);
  71. (* (Option.value ~default:"anonymous" (); *)
  72. try QCheck.Test.check_exn test with
  73. | QCheck.Test.Test_fail (test_name,counter_examples) ->
  74. Printf.printf "FAILED: %s\n%!" test_name;
  75. List.iter ~f:(fun example -> Printf.printf "%s\n" example) counter_examples
  76. | QCheck.Test.Test_error (str1, str2, error,_) ->
  77. Printf.printf "FAILED: %s, %s\n%!" str1 str2;
  78. raise error

  79. let main =
  80. Printf.printf "\n%!";
  81. List.iter ~f:perform_test
  82. [ (* Add your tests in this list *)
  83. ];
  84. Printf.printf "Done.\n%!"

Quelques arbres binaires particuliers.

Écrivez plusieurs fonctions, qui étant donné un entier $n$, construisent les arbres suivants. Tous les nœuds contiendront une valeur de type unit.

  • l'arbre complet de hauteur $n$,
  • le chemin gauche et le chemin droit de hauteur $n$,
  • la chenille gauche et la chenille droite de hauteur $n$.

Arbre complet de hauteur 3 Chemin gauche de hauteur 6 Chemin droit de hauteur 6 chenille gauche de hauteur 7 chenille droite de hauteur 7

  1. val complete : int -> unit bintree
  2. val left_path : int -> unit bintree
  3. val right_path : int -> unit bintree
  4. val left_caterpillar : int -> unit bintree
  5. val right_caterpillar : int -> unit bintree

Hauteur d'un arbre.

Écrivez la fonction calculant la hauteur d'un arbre binaire.

  1. val height : 'node bintree -> int

Testez que les arbres créés précédemment ont bien la hauteur souhaitée.

Image miroir d'un arbre.

Écrivez une fonction calculant l'image miroir d'un arbre, comme illustré par le dessin ci-dessous.

Un arbre quelconque euqnocleuq erbra nU
  1. val mirror : 'node bintree -> 'node bintree

Testez que les chemins gauches et droits sont miroirs l'un de l'autre, que les chenilles gauches et droite sont miroirs l'un de l'autre, que l'arbre complet est miroir de lui-même.

Map.

Écrivez la fonction map des arbres binaires. map ~f construit une image de l'arbre en remplaçant chaque nœud par son image par la fonction f.

  1. val map : 'node bintree -> f:('node -> 'im) -> 'im bintree

Reduce.

Écrivez une fonction fold des arbres binaires. Elle doit correspondre à faire un List.fold_left sur une liste des nœuds de l'arbre, en ordre infixe.

  1. val fold : f:('state -> 'node -> 'state) -> 'state -> 'node bintree -> 'state

Lister les nœuds.

Écrivez une fonction retournant une liste de nœuds d'un arbre binaire, en ordre infixe. Pour cela, on utilisera une fonction annexe insert_nodes_of tree accu, ajoutant tous les nœuds de tree dans l'accumulateur accu.

  1. val insert_nodes_of : 'node bintree -> 'node list -> 'node list
  2. val nodes_of_tree : 'node bintree -> 'node list

On peut aussi utiliser fold pour réaliser cette fonction, comment ? La version sans fold permet de préparer la prochaine question.

Lister les arêtes.

Écrivez une fonction retournant la liste des paires (parent,enfant) d'un arbre binaire (observer l'arbre sur ces deux premiers niveaux).

  1. val edges_of_tree : 'node bintree -> ('node * 'node) list

Pour des raisons d'efficacité, il est préférable d'utiliser une fonction avec un argument supplémentaire qui contient la liste des arêtes au fur et à mesure qu'elle est construite.

Dessin d'arbres.

Dessin vectoriel de l'arbre.

Pour dessiner un arbre, il faut donner une position à chaque nœud. Nous allons donc écrire une fonction :

  1. val draw : Gg.p2 tree -> Vg.img

Le principe est simple : chaque sommet est dessiné avec un cercle de même rayon (disons $0.1$), chaque arête est dessinée par un segment entre les deux nœuds correspondant.

Voici un petit rappel de Vg, cela ne remplace pas la documentation mais vous permet de savoir de quelles fonctions vous avez besoin :

  1. type image

  2. (* module for paths, describing shapes to be cut in colored papers *)
  3. module P : sig
  4. type t
  5. (* an empty shape, to start with. *)
  6. val empty : t

  7. (* moves the path to a given point, starting a new shape. *)
  8. val sub : Gg.p2 -> t -> t

  9. (* adds a segment in the current shape to a given point. *)
  10. val line : Gg.p2 -> t -> t

  11. (* adds a circular shape to the current path *)
  12. val circle : Gg.p2 -> float -> t -> t
  13. end

  14. (* module for images, can be glued on each others *)
  15. module I : sig
  16. (* a color-uniform image, infinite in all direction, in the given color. *)
  17. val const : Gg.Color -> image

  18. (* cuts an image along a given shape, this gives a new image. *)
  19. val cut : ?area:Vg.P.area -> Gg.P.t -> image -> image

  20. (* [blend foreground background] glues an image on top of another image. *)
  21. val blend : image -> image -> image
  22. end

Commencez par écrire une fonction pour le dessin d'un sommet, et pour le dessin d'une arête.

  1. val draw_node : Gg.p2 -> Vg.image
  2. val draw_edge : Gg.p2 * Gg.p2 -> Vg.image

Puis, utilisez les fonctions sur les arbres pour obtenir la liste des images de chaque nœud et de chaque arête. Utilisez Vg.I.blend pour aggréger toutes ces images en une seule image (Vg.I définit un monoïde, quel est le zéro et quel est l'opérateur binaire ?).

Vous obtenez alors :

  1. val draw_tree : Gg.p2 bintree -> Vg.image

Ajoutez un module supportant l'export au format svg, donné ci-dessous. (L'image produite est centrée sur le point (0,5) et est un carré de longueur 20, vous pouvez changer ces paramètres en modifiant la valeur view du module.)

  1. (* Create files exportSvg.ml and exportSvg.mli with this *)

  2. module ExportSvg : sig
  3. (** Draw an image into a file in format svg *)
  4. val draw :
  5. ?view:Gg.box2 ->
  6. title:string ->
  7. description:string ->
  8. filename:string ->
  9. Vg.image ->
  10. unit

  11. (** draw a path in the given color (or black) into a file in format svg *)
  12. val draw_path :
  13. ?view:Gg.box2 ->
  14. ?color:Gg.Color.t ->
  15. title:string ->
  16. description:string ->
  17. filename:string ->
  18. Vg.path ->
  19. unit
  20. end =
  21. struct
  22. let img_of_path ~color path =
  23. let area = Vg.P.(`O {o with width = 0.05}) in
  24. Vg.I.const color
  25. |> Vg.I.cut ~area path

  26. let size = Gg.Size2.v 200. 200.
  27. let view =
  28. let open Gg in
  29. Box2.v V2.(v (-20.)(-38.)) V2.(v 40. 40.)

  30. let draw ?(view=view) ~title ~description ~filename img =
  31. let open Vg in
  32. let out_chan = open_out filename in
  33. let target =
  34. Vgr_svg.target
  35. ~xmp:(Vgr.xmp ~title ~description ())
  36. ()
  37. in
  38. let img =
  39. Vg.I.blend img (Vg.I.const Gg.Color.white)
  40. in
  41. let renderer =
  42. Vgr.create
  43. ~warn:(Vgr.pp_warning Format.err_formatter)
  44. target
  45. (`Channel out_chan)
  46. in
  47. ignore (Vgr.render renderer (`Image (size, view, img)));
  48. ignore (Vgr.render renderer `End);
  49. close_out out_chan

  50. let draw_path
  51. ?(view=view)
  52. ?(color=Gg.Color.black)
  53. ~title
  54. ~description
  55. ~filename
  56. path =
  57. let img = img_of_path ~color path in
  58. draw ~title ~description ~filename img

  59. end

Positionnement des nœuds.

Il nous faut maintenant convertir notre arbre portant des informations quelconques dans ses nœuds, en un arbre dont chaque nœud contient la position du nœud dans le dessin.

Attribuons la position $(0,0)$ à la racine. Donnez un algorithme qui dessine toutes les arêtes comme des diagonales de longueur 1. Ainsi, si la position du parent est $(x,y)$, la position de ses enfants est $(x-1,y-1)$ et $(x+1,y-1)$.

Testez votre fonction avec quelques arbres. Qu'en pensez-vous ?

Avec cet algorithme, la distance entre deux frères est toujours de $2$, ce qui provoque des chevauchements. Donnez un autre algorithme qui divise par deux la distance entre deux frères pour chaque profondeur, afin d'interdire les chevauchements. Plus des frères sont profonds, plus ils sont proches.

Ajoutez un troisième algorithme qui divise aussi la distance verticale entre deux profondeurs par deux à chaque niveau de l'arbre. Avec cet algorithme, tout arbre aura un dessin contenu dans un rectangle de dimension $4 \times 2$.