3 unit presentation : procedure;
\r
12 call outstring("LES ARBRES 2-3");
\r
15 call outstring("MENU :");
\r
18 call outstring("1 -> inserer un element");
\r
20 call outstring("2 -> supprimer un element");
\r
22 call outstring("3 -> existence d'un element");
\r
24 call outstring("4 -> minimum de l'arbre");
\r
26 call outstring("5 -> maximum de l'arbre");
\r
28 call outstring("6 -> vide");
\r
30 call outstring("7 -> afficher l'arbre");
\r
32 call outstring("8 -> fin");
\r
34 call outstring("choix =");
\r
38 unit inchar: iiuwgraph function:integer;
\r
43 if i=/=0 then exit fi;
\r
48 unit reponse : IIUWgraph procedure(output r : char);
\r
51 call outstring("Tapez o/n pour continuer");
\r
54 call hascii(ord(r));
\r
58 unit WriteInteger : IIUWgraph procedure( Number : integer );
\r
63 call HASCII( Number + 48 );
\r
67 j := Number - i * 10;
\r
69 call Hascii( i + 48 );
\r
71 call Hascii( j + 48 );
\r
76 (* representation d'un noeud *)
\r
84 nb est le nombre de fils
\r
85 IG est l'information de gauche
\r
86 IM est l'information de droite
\r
87 FG est le fils de gauche
\r
88 FM est le fils du milieu
\r
89 FD est le fils de droite
\r
92 (* initialisation des variables *)
\r
104 unit barbre : class;
\r
105 var racine : noeud;
\r
107 unit afficher : procedure(inout courant : noeud);
\r
111 (* courant pointe sur une feuille *)
\r
112 writeln(courant.IG:1);
\r
114 (* courant pointe sur un noeud *)
\r
115 writeln(courant.IG:1, ":", courant.IM:1);
\r
118 if courant.FG =/= none
\r
120 (* courant a 1, 2 ou 3 fils *)
\r
121 if courant.FG.FG =/= none
\r
123 (* courant a 2 ou 3 petits fils *)
\r
124 (* appel de la procedure afficher avec le fils gauche de courant *)
\r
125 call afficher(courant.FG);
\r
126 if courant.FM =/= none
\r
128 (* courant a 2 ou 3 fils *)
\r
129 (* appel de la procedure afficher avec le fils milieu de courant *)
\r
130 call afficher(courant.FM);
\r
131 if courant.FD =/= none
\r
133 (* courant a 3 fils *)
\r
134 (* appel de la procedure afficher avec le fils droit de courant *)
\r
135 call afficher(courant.FD);
\r
139 (* courant n'a pas de petits fils
\r
140 i.e. les fils de courant sont des feuilles *)
\r
141 (* affichage de la feuille de gauche *)
\r
142 write(courant.FG.IG:1);
\r
143 if courant.FM =/= none
\r
145 (* courant a 2 ou 3 fils *)
\r
146 (* affichage de la feuille du milieu *)
\r
147 write(" ", courant.FM.IG:1);
\r
148 if courant.FD =/= none
\r
150 (* courant a 3 fils *)
\r
151 (* affichage de la feuille de droite *)
\r
152 writeln(" ", courant.FD.IG:1);
\r
163 unit reorganiser : procedure(inout courant,bidon : noeud);
\r
165 if courant.FG =/= none
\r
167 (* courant a 1, 2 ou 3 fils *)
\r
168 if courant.FG.FG =/= none
\r
170 (* courant a 2 ou 3 petits fils *)
\r
171 (* appel de la procedure reorganiser avec le fils gauche *)
\r
172 call reorganiser(courant.FG, bidon);
\r
173 (* appel de la procedure reorganiser avec le fils milieu *)
\r
174 call reorganiser(courant.FM, bidon);
\r
175 if courant.FD =/= none
\r
177 (* courant a 3 fils *)
\r
178 (* appel de la procedure reorganiser avec le fils droit *)
\r
179 call reorganiser(courant.FD, bidon);
\r
182 (* recherche du plus grand element dans le sous arbre
\r
183 gauche de courant pour recuperer le IG de courant *)
\r
184 bidon := courant.FG;
\r
187 when 0 : courant.IG := bidon.IG;
\r
189 when 1 : bidon := bidon.FG;
\r
191 when 2 : bidon := bidon.FM;
\r
193 when 3 : bidon := bidon.FD;
\r
197 (* recherche du plus grand element dans le sous arbre
\r
198 du milieu de courant pour recuperer le IM de courant *)
\r
199 bidon := courant.FM;
\r
202 when 0 : courant.IM := bidon.IG;
\r
204 when 1 : bidon := bidon.FG;
\r
206 when 2 : bidon := bidon.FM;
\r
208 when 3 : bidon := bidon.FD;
\r
212 (* courant n'a pas de petis fils *)
\r
213 (* recuperation de IG pour courant *)
\r
214 courant.IG := courant.FG.IG;
\r
215 if courant.nb =/= 1
\r
217 (* recuperation de IM pour courant *)
\r
218 (* courant a 2 ou 3 fils *)
\r
219 courant.IM := courant.FM.IG;
\r
225 unit vide : function : boolean;
\r
227 result := (racine.nb = 0);
\r
230 unit minimum : function : integer;
\r
231 var courant : noeud;
\r
235 if courant.FG = none
\r
237 (* result contient le plus petit element de l'arbre *)
\r
238 result := courant.IG;
\r
241 (* descendre a gauche *)
\r
242 courant := courant.FG;
\r
247 unit maximum : function : integer;
\r
248 var courant : noeud;
\r
252 (* suivant le nombre de fils de courant *)
\r
254 when 0 : (* result contient le plus grand element de l'arbre *)
\r
255 result := courant.IG;
\r
257 when 1 : (* le plus grand element se trouve
\r
258 dans le sous arbre de gauche *)
\r
259 courant := courant.FG;
\r
261 when 2 : (* le plus grand element se trouve
\r
262 dans le sous arbre du milieu *)
\r
263 courant := courant.FM;
\r
265 when 3 : (* le plus grand element se trouve
\r
266 dans le sous arbre de droite *)
\r
267 courant := courant.FD;
\r
272 unit present : function(v : integer; inout courant : noeud) : boolean;
\r
275 (* suivant le nombre de fils de courant *)
\r
277 when 0 : (* 0 fils donc c'est une feuille *)
\r
279 then result := true;
\r
280 else result := false;
\r
283 when 1 : (* 1 fils donc le pere est la racine *)
\r
284 courant := courant.FG;
\r
286 then result := true;
\r
287 else result := false;
\r
290 when 2 : (* 2 fils *)
\r
293 (* v se trouve a gauche, si il existe *)
\r
294 courant := courant.FG;
\r
298 if courant.nb =/= 0
\r
300 courant := courant.FG;
\r
303 (* v ne se trouve pas a gauche, si il existe *)
\r
306 (* v se trouve au milieu, si il existe *)
\r
307 courant := courant.FM;
\r
311 if courant.nb =/= 0
\r
313 courant := courant.FM;
\r
316 courant := courant.FM;
\r
321 when 3 : (* 3 fils *)
\r
324 (* v se trouve a gauche, si il existe *)
\r
325 courant := courant.FG;
\r
329 if courant.nb =/= 0
\r
331 courant := courant.FG;
\r
334 (* v ne se trouve pas a gauche, si il existe *)
\r
337 (* v se trouve au milieu, si il existe *)
\r
338 courant := courant.FM;
\r
342 if courant.nb =/= 0
\r
344 courant := courant.FM;
\r
347 (* v ne se trouve pas a gauche, si il existe *)
\r
350 (* v se trouve a droite, si il existe *)
\r
351 courant := courant.FD;
\r
365 unit supprimer : IIUWgraph function(v: integer) : barbre;
\r
366 var courant, p : noeud,
\r
371 if present(v, courant)
\r
373 (* l'element est present dans l'arbre donc on peut le supprimer *)
\r
377 (* p pointe sur la racine *)
\r
379 when 1 : (* p a 1 fils *)
\r
381 courant.FG := none;
\r
385 when 2 : (* p a 2 fils *)
\r
386 if p.FG.IG = courant.IG
\r
394 when 3 : (* p a 3 fils *)
\r
395 if p.IG = courant.IG
\r
402 if p.FM.IG = courant.IG
\r
412 (* p ne pointe pas sur le racine *)
\r
414 when 2 : (* p a 2 fils *)
\r
415 pref IIUWgraph block
\r
419 call outstring("-> Le cas ou l'on veut supprimer une feuille");
\r
421 call outstring("dont le pere a 2 fils n'a pas ete gere.");
\r
424 when 3 : (* p a 3 fils *)
\r
425 if p.FG.IG = courant.IG
\r
432 if p.FM.IG = courant.IG
\r
444 pref IIUWgraph block
\r
447 call outstring("-> On ne peut pas supprimer cet element");
\r
449 call outstring("car il n'est pas dans l'arbre");
\r
452 b.racine := racine;
\r
456 unit inserer : function(v : integer) : barbre;
\r
458 unit refaire : procedure(inout p, f1, f2, j, r : noeud);
\r
460 (* suivant le nombre de fils de p *)
\r
462 when 3 : (* p a 3 fils *)
\r
471 when 4 : (* p a 4 fils *)
\r
472 (* et creer un nouveau noeud *)
\r
498 (* le pere de p n'est pas la racine *)
\r
499 (* il faut repeter la procedure refaire *)
\r
501 p.pere.nb := p.pere.nb + 1;
\r
502 call refaire(p.pere, p, j, j, r);
\r
504 (* le pere de p est la racine *)
\r
505 (* donc il faut creer une nouvelle racine *)
\r
518 var bidon, courant, i, f1, f2, j, p, r : noeud,
\r
524 bidon := new noeud;
\r
525 courant := new noeud;
\r
535 (* l'arbre est vide *)
\r
536 (* creer la feuille qui contiendra l'element a inserer *)
\r
537 courant := new noeud;
\r
538 courant.pere := racine;
\r
542 racine.FG := courant;
\r
544 b.racine := racine;
\r
548 (* l'arbre n'est pas vide *)
\r
550 if present(v,courant)
\r
552 pref IIUWgraph block
\r
555 call outstring("-> L'element ne peut etre inserer");
\r
557 call outstring("puisqu'il appartient deja a l'arbre.");
\r
560 (* l'element n'existe pas dans l'arbre *)
\r
567 i.pere := courant.pere;
\r
570 (* creer le noeud qui contiendra l'element a inserer *)
\r
571 courant := new noeud;
\r
576 (* determination de la position ou inserer l'element *)
\r
598 (* suivant le nombre de fils de p *)
\r
600 when 2 : (* p a 2 fils *)
\r
601 if courant.IG > i.IG
\r
602 then pos := pos + 1;
\r
605 (* suivant la position de l'element *)
\r
607 when 1 : p.FM := p.FG;
\r
609 when 2 : p.FM := courant;
\r
611 when 3 : (* p a 3 fils *)
\r
612 if courant.IG > i.IG
\r
613 then pos := pos + 1;
\r
616 (* suivant la position de l'element *)
\r
618 when 1 : p.FD := p.FM;
\r
621 when 2 : p.FD := p.FM;
\r
623 when 3 : p.FD := courant;
\r
625 when 4 : (* p a 4 fils *)
\r
626 if courant.IG > i.IG
\r
627 then pos := pos + 1;
\r
633 (* suivant la position de l'element *)
\r
635 when 1 : f1 := p.FM;
\r
641 when 2 : f1 := p.FM;
\r
646 when 3 : f1 := courant;
\r
650 when 4 : f1 := p.FD;
\r
668 (* il faut repeter la procedure refaire *)
\r
670 p.pere.nb := p.pere.nb + 1;
\r
671 call refaire(p.pere, p, j, j, r);
\r
673 (* p est la racine *)
\r
674 (* donc il faut creer une nouvelle racine *)
\r
687 b.racine := courant;
\r
693 racine := new noeud;
\r
698 touche, e : integer,
\r
699 bidon, courant, a, b : noeud,
\r
705 courant := new noeud;
\r
706 courant := ba.racine;
\r
708 pref IIUWgraph block
\r
713 call WriteInteger(choix);
\r
714 (* selon le choix *)
\r
716 when 1 : (* inserer un element *)
\r
724 call outstring("-> Entrez l'element a inserer = ");
\r
726 call WriteInteger(e);
\r
727 courant := ba.racine;
\r
728 ba := ba.inserer(e);
\r
729 courant := ba.racine;
\r
730 call ba.reorganiser(courant, bidon);
\r
742 when 2 : (* supprimer un element *)
\r
752 call outstring("-> Il est impossible de supprimer un element");
\r
754 call outstring("dans un arbre vide");
\r
757 call outstring("-> Entrez l'element a supprimer = ");
\r
759 call WriteInteger(e);
\r
760 courant := ba.racine;
\r
761 ba := ba.supprimer(e);
\r
762 courant := ba.racine;
\r
763 call ba.reorganiser(courant,bidon);
\r
775 when 3 : (* determiner si l'element est present dans l'arbre *)
\r
785 call outstring("-> Il est impossible de rechercher un element");
\r
787 call outstring("dans un arbre vide");
\r
790 call outstring("Entrez l'element = ");
\r
792 call WriteInteger(e);
\r
793 courant := ba.racine;
\r
794 if ba.present(e,courant)
\r
797 call outstring("-> L'element est present");
\r
800 call outstring("-> L'element est absent");
\r
814 when 4 : (* determiner l'element minimum *)
\r
820 call outstring("-> Il est impossible de rechercher le minimum");
\r
822 call outstring("dans un arbre vide");
\r
826 call outstring("-> Le minimum est ");
\r
827 call WriteInteger(e);
\r
829 call move(250,325);
\r
830 call outstring("Tapez une touche pour continuer");
\r
833 when 5 : (* determiner l'element maximum *)
\r
839 call outstring("-> Il est impossible de rechercher le maximum");
\r
841 call outstring("dans un arbre vide");
\r
845 call outstring("-> Le maximum est ");
\r
846 call WriteInteger(e);
\r
848 call move(250,325);
\r
849 call outstring("Tapez une touche pour continuer");
\r
852 when 6 : (* determiner si l'arbre est vide *)
\r
856 if ba.vide then call outstring("-> L'arbre est vide");
\r
857 else call outstring("-> L'arbre n'est pas vide");
\r
859 call move(250,325);
\r
860 call outstring("Tapez une touche pour continuer");
\r
863 when 7 : (* affichage de l'arbre *)
\r
869 call outstring("L'arbre est vide.");
\r
871 courant := ba.racine;
\r
872 call ba.afficher(courant);
\r
874 call move(250,325);
\r
875 call outstring("Tapez une touche pour continuer");
\r
878 when 8 : (* fin du programme *)
\r