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.
type 'elt t =
| Leaf
| Node of 'elt t * 'elt * 'elt t
module Arbitrary : sig
val pp :
(Format.formatter -> 'elt -> unit)
-> Format.formatter -> 'elt t -> unit
val tree : 'elt QCheck.arbitrary -> 'elt t QCheck.arbitrary
val int_tree : int t QCheck.arbitrary
val unit_tree : unit t QCheck.arbitrary
end = struct
let rec pp elt_pp formatter = function
| Leaf ->
Format.fprintf formatter "Leaf"
| Node (left,root,right) ->
Format.fprintf formatter
"@[<hv 2>Node (@;@[<hv>%a,@;%a,@;%a@]@;)@]"
(pp elt_pp) left
elt_pp root
(pp elt_pp) right
let print : 'elt QCheck.Print.t -> 'elt t QCheck.Print.t =
fun elt_print tree ->
let open Format in
let elt_pp formatter elt =
fprintf formatter "%s" (elt_print elt)
in
asprintf "%a" (pp elt_pp) tree
let rec shrink : 'elt QCheck.Shrink.t -> 'elt t QCheck.Shrink.t =
fun elt_shrink ->
let open QCheck.Iter in
function
| Leaf -> empty
| Node (left,root,right) ->
of_list [ left; right ]
<+> (shrink elt_shrink left
>|= fun left_red -> Node (left_red,root,right))
<+> (shrink elt_shrink right
>|= fun right_red -> Node (left,root,right_red))
<+> (elt_shrink root
>|= fun root_red -> Node (left,root_red,right))
let rec tree_gen : 'elt QCheck.Gen.t -> int -> 'elt t QCheck.Gen.t =
fun elt_gen size ->
let open QCheck.Gen in
if size <= 0 then return Leaf
else
0 -- (size-1) >>= fun size_left ->
let size_right = size - size_left - 1 in
tree_gen elt_gen size_left >>= fun left ->
tree_gen elt_gen size_right >>= fun right ->
elt_gen >>= fun root ->
return (Node (left,root,right))
let tree : 'elt QCheck.arbitrary -> 'elt t QCheck.arbitrary =
fun elt_arbitrary ->
let open QCheck in
QCheck.make
?print:Option.(elt_arbitrary.print >>| print)
?shrink:Option.(elt_arbitrary.shrink >>| shrink)
(Gen.sized (tree_gen elt_arbitrary.gen))
let int_tree = tree QCheck.small_int
let unit_tree = tree QCheck.unit
end
let perform_test ((QCheck.Test.Test cell) as test) =
Printf.printf "Next test: %s\n%!" (QCheck.Test.get_name cell);
try QCheck.Test.check_exn test with
| QCheck.Test.Test_fail (test_name,counter_examples) ->
Printf.printf "FAILED: %s\n%!" test_name;
List.iter ~f:(fun example -> Printf.printf "%s\n" example) counter_examples
| QCheck.Test.Test_error (str1, str2, error,_) ->
Printf.printf "FAILED: %s, %s\n%!" str1 str2;
raise error
let main =
Printf.printf "\n%!";
List.iter ~f:perform_test
[
];
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$.
val complete : int -> unit bintree
val left_path : int -> unit bintree
val right_path : int -> unit bintree
val left_caterpillar : int -> unit bintree
val right_caterpillar : int -> unit bintree
Hauteur d'un arbre.
Écrivez la fonction calculant la hauteur d'un arbre binaire.
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.
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.
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.
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.
val insert_nodes_of : 'node bintree -> 'node list -> 'node list
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).
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 :
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 :
type image
module P : sig
type t
val empty : t
val sub : Gg.p2 -> t -> t
val line : Gg.p2 -> t -> t
val circle : Gg.p2 -> float -> t -> t
end
module I : sig
val const : Gg.Color -> image
val cut : ?area:Vg.P.area -> Gg.P.t -> image -> image
val blend : image -> image -> image
end
Commencez par écrire une fonction pour le dessin d'un sommet, et pour le dessin d'une arête.
val draw_node : Gg.p2 -> Vg.image
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 :
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.)
module ExportSvg : sig
val draw :
?view:Gg.box2 ->
title:string ->
description:string ->
filename:string ->
Vg.image ->
unit
val draw_path :
?view:Gg.box2 ->
?color:Gg.Color.t ->
title:string ->
description:string ->
filename:string ->
Vg.path ->
unit
end =
struct
let img_of_path ~color path =
let area = Vg.P.(`O {o with width = 0.05}) in
Vg.I.const color
|> Vg.I.cut ~area path
let size = Gg.Size2.v 200. 200.
let view =
let open Gg in
Box2.v V2.(v (-20.)(-38.)) V2.(v 40. 40.)
let draw ?(view=view) ~title ~description ~filename img =
let open Vg in
let out_chan = open_out filename in
let target =
Vgr_svg.target
~xmp:(Vgr.xmp ~title ~description ())
()
in
let img =
Vg.I.blend img (Vg.I.const Gg.Color.white)
in
let renderer =
Vgr.create
~warn:(Vgr.pp_warning Format.err_formatter)
target
(`Channel out_chan)
in
ignore (Vgr.render renderer (`Image (size, view, img)));
ignore (Vgr.render renderer `End);
close_out out_chan
let draw_path
?(view=view)
?(color=Gg.Color.black)
~title
~description
~filename
path =
let img = img_of_path ~color path in
draw ~title ~description ~filename img
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$.
