5 (* ANNEE UNIVERSITAIRE 1993/1994 : Universit
\82 de Pau *)
\r
7 (* DATE DE REMISE : 15 JANVIER 1994 *)
\r
9 (* SUJET : ARBRES BICOLORES *)
\r
11 (* GROUPE 2 , LICENCE INFORMATIQUE , LI1 *)
\r
15 (* JACQUES LATAPIE *)
\r
17 (* SUJET PROPOSE PAR MME MIRKOWSKA *)
\r
21 var elem:integer,gauche,droite,pere:noeud,couleur:integer;
\r
25 (* RECHERCHE DU MINIMUN *)
\r
26 unit recmin:function(t:noeud):noeud;
\r
28 if t.gauche=z then result:=t;
\r
29 else result:=recmin(t.gauche);
\r
34 (* RECHERCHE DU MAXIMUM *)
\r
35 unit recmax:function(t:noeud):noeud;
\r
37 if t.droite=z then result:=t;
\r
38 else result:=recmax(t.droite);
\r
43 (* SUPPRESSION D'UN ELEMENT COMME DANS UN ARBRE BST *)
\r
44 unit suppression:iiuwgraph procedure(inout t:noeud,supp:noeud,remplacant:noeud);
\r
47 if supp.gauche=z or supp.droite=z
\r
48 then remplacant:=supp;
\r
49 else remplacant:=recmin(supp.droite);
\r
51 if remplacant.gauche<>z
\r
52 then locale:=remplacant.gauche;
\r
53 else locale:=remplacant.droite;
\r
55 locale.pere:=remplacant.pere;
\r
56 if remplacant.pere=remplacant
\r
59 else if remplacant=remplacant.pere.gauche
\r
60 then remplacant.pere.gauche:=locale;
\r
61 else remplacant.pere.droite:=locale;
\r
64 if remplacant<>supp then supp.elem:=remplacant.elem;fi;
\r
65 if remplacant.couleur=0 then call suppresmaj(t,locale);fi;
\r
69 (* ROTATION ET INVERSION DES COULEURS APRES SUPPRESSION *)
\r
70 unit suppresmaj:iiuwgraph procedure(inout t:noeud,rond:noeud);
\r
71 var local:noeud,rep:integer;
\r
73 while rond<>t and rond.couleur=0
\r
75 if rond=rond.pere.gauche
\r
77 local:=rond.pere.droite;
\r
81 rond.pere.couleur:=1;
\r
82 call gauch(t,rond.pere);
\r
84 call visua(t,0.5,1,0,0);
\r
87 call outstring("Visua. apr
\8as rot. Gauche sur ");
\r
88 call writeinteger(rond.pere.elem);
\r
89 call outstring(" <RETURN> ");
\r
92 local:=rond.pere.droite;
\r
94 if local.gauche.couleur=0 and local.droite.couleur=0
\r
99 if local.droite.couleur=0
\r
100 then local.gauche.couleur:=0;
\r
102 call droit(t,local);
\r
104 call visua(t,0.5,1,0,0);
\r
107 call outstring("Rotation Droite sur ");
\r
108 call writeinteger(local.elem);
\r
109 call outstring(" <RETURN> ");
\r
112 local:=rond.pere.droite;
\r
114 local.couleur:=rond.pere.couleur;
\r
115 rond.pere.couleur:=0;
\r
116 local.droite.couleur:=0;
\r
117 call gauch(t,rond.pere);
\r
119 call visua(t,0.5,1,0,0);
\r
122 call outstring("Rotation Gauche sur ");
\r
123 call writeinteger(rond.pere.elem);
\r
124 call outstring(" <RETURN> ");
\r
130 local:=rond.pere.gauche;
\r
134 rond.pere.couleur:=1;
\r
135 call droit(t,rond.pere);
\r
137 call visua(t,0.5,1,0,0);
\r
140 call outstring("Rotation Droite sur ");
\r
141 call writeinteger(rond.pere.elem);
\r
142 call outstring(" <RETURN> ");
\r
145 local:=rond.pere.gauche;
\r
147 if local.droite.couleur=0 and local.gauche.couleur=0
\r
152 if local.gauche.couleur=0
\r
154 local.droite.couleur:=0;
\r
156 call gauch(t,local);
\r
158 call visua(t,0.5,1,0,0);
\r
161 call outstring("Rotation Gauche sur ");
\r
162 call writeinteger(local.elem);
\r
163 call outstring(" <RETURN> ");
\r
166 local:=rond.pere.gauche;
\r
168 local.couleur:=rond.pere.couleur;
\r
169 rond.pere.couleur:=0;
\r
170 local.gauche.couleur:=0;
\r
171 call droit(t,rond.pere);
\r
173 call visua(t,0.5,1,0,0);
\r
176 call outstring("Rotation Droite sur ");
\r
177 call writeinteger(rond.pere.elem);
\r
178 call outstring(" <RETURN> ");
\r
189 (* INSERSION COMME DANS UN ARBRE BST *)
\r
190 unit insert_bst: procedure(nb:integer;inout r:noeud,x:noeud,p:noeud,trouve:integer);
\r
196 if p=z then r.pere:=r;
\r
203 (*("CET ELEMENT EST DEJA INSERE !!! ");*)
\r
207 if nb<r.elem then call insert_bst(nb,r.gauche,x,r,trouve);
\r
208 else call insert_bst(nb,r.droite,x,r,trouve);
\r
214 (* ROTATIONS ET CHANGEMENTS DE COULEURS APRES INSERSION *)
\r
215 unit insert:iiuwgraph procedure(inout x:noeud;inout racine:noeud);
\r
216 var y,valeur:noeud,rep:integer;
\r
221 while ((x<>racine) and (x.pere.couleur=1))
\r
224 call visua(racine,0.5,1,0,0);
\r
227 call outstring("On a deux noeuds rouges cons
\82cutifs ");
\r
228 call writeinteger(x.elem);
\r
229 call outstring(" et ");
\r
230 call writeinteger(x.pere.elem);
\r
231 call outstring(" <RETURN> ");
\r
234 if x.pere=x.pere.pere.gauche
\r
236 y:=x.pere.pere.droite;
\r
239 (* L'oncle de x.elem est rouge donc inversion des couleurs*)
\r
242 x.pere.pere.couleur:=1;
\r
243 call visua(racine,0.5,1,0,0);
\r
246 call outstring("Visualisation apr
\8as inversion des couleur <RETURN> ");
\r
251 if x=x.pere.droite
\r
254 call gauch(racine,x);
\r
256 call visua(racine,0.5,1,0,0);
\r
259 call outstring("Visualisation apr
\8as rot. gauche au niveau de ");
\r
260 call writeinteger(x.elem);
\r
261 call outstring(" <RETURN> ");
\r
266 x.pere.pere.couleur:=1;
\r
267 if x.pere.pere=racine
\r
268 then valeur:=x.pere;
\r
269 else valeur:=x.pere.pere.pere;
\r
271 call droit(racine,x.pere.pere);
\r
272 x.pere.pere:=valeur;
\r
274 call visua(racine,0.5,1,0,0);
\r
277 call outstring("Visu.ap
\8as r
\82tab. des couleurs et rot. D sur ");
\r
278 call writeinteger(x.pere.pere.elem);
\r
279 call outstring(" <RETURN> ");
\r
284 y:=x.pere.pere.gauche;
\r
287 (* L'oncle de x.elem est rouge donc inversion des couleurs*)
\r
290 x.pere.pere.couleur:=1;
\r
292 call visua(racine,0.5,1,0,0);
\r
295 call outstring("Visua. apr
\8as inversion des couleurs <RETURN>");
\r
303 call droit(racine,x);
\r
305 call visua(racine,0.5,1,0,0);
\r
308 call outstring("Visualisation apr
\8as rotation droite au niveau de ");
\r
309 call writeinteger(x.elem);
\r
310 call outstring(" <RETURN> ");
\r
315 x.pere.pere.couleur:=1;
\r
316 if x.pere.pere=racine
\r
317 then valeur:=x.pere;
\r
318 else valeur:=x.pere.pere.pere;
\r
320 call gauch(racine,x.pere.pere);
\r
321 x.pere.pere:=valeur;
\r
323 call visua(racine,0.5,1,0,0);
\r
326 call outstring("Visu.apr
\8as r
\82tab. des couleurs et rot. gauche sur ");
\r
327 call writeinteger(x.pere.pere.elem);
\r
328 call outstring(" <RETURN> ");
\r
338 (* ROTATION GAUCHE *)
\r
339 unit gauch:procedure(inout t:noeud;inout aux1:noeud);
\r
343 aux1.droite:=fils.gauche;
\r
344 if aux1<>t then fils.pere:=aux1.pere;
\r
345 else fils.pere:=fils;
\r
347 if fils.gauche<>z then fils.gauche.pere:=aux1;fi;
\r
348 if aux1.pere=aux1 then t:=fils;
\r
350 if aux1=aux1.pere.gauche
\r
352 aux1.pere.gauche:=fils;
\r
354 aux1.pere.droite:=fils;
\r
362 (* ROTATION DROITE *)
\r
364 unit droit:procedure(inout t:noeud;inout aux2:noeud);
\r
367 child:=aux2.gauche;
\r
368 aux2.gauche:=child.droite;
\r
369 if child.droite<>z then child.droite.pere:=aux2;fi;
\r
370 if aux2<>t then child.pere:=aux2.pere;
\r
371 else child.pere:=child;
\r
373 if aux2.pere=aux2 then t:=child;
\r
375 if aux2=aux2.pere.droite
\r
376 then aux2.pere.droite:=child;
\r
377 else aux2.pere.gauche:=child;
\r
380 child.droite:=aux2;
\r
385 (* RECHERCHE D'UN ELEMENT QUELCONQUE *)
\r
386 unit recherche: iiuwgraph procedure(r:noeud;nb:integer;inout pointeur:noeud);
\r
392 call move(200,100);
\r
393 if r.elem=nb then call outstring("Element ");
\r
394 call writeinteger(nb);
\r
395 call outstring(" est trouv
\82 dans l'arbre");
\r
396 call move(200,120);
\r
397 call outstring(" COULEUR = ");
\r
398 if r.couleur=1 then
\r
399 call outstring(" ROUGE ");
\r
400 else call outstring(" NOIR ");
\r
402 call move(200,140);
\r
403 call outstring(" PERE = ");
\r
404 call writeinteger(r.pere.elem);
\r
405 call move(200,160);
\r
406 if r.gauche<>z then call outstring("FILS GAUCHE = ");
\r
407 call writeinteger(r.gauche.elem);fi;
\r
408 call move(200,180);
\r
409 if r.droite<>z then call outstring("FILS DROIT = ");
\r
410 call writeinteger(r.droite.elem);fi;
\r
412 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER .. ");
\r
417 if nb>r.elem then r:=r.droite;
\r
423 call move(200,160);
\r
424 call writeinteger(nb);
\r
425 call outstring(" N'APPARTIENT PAS A L'ARBRE ");
\r
427 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ...");
\r
435 (* PROCEDURES ET FONCTIONS UTILISANT LE MODE GRAPHIQUE *)
\r
437 unit inchar: iiuwgraph function:integer;
\r
442 if i=/=0 then exit fi;
\r
448 unit ReadInteger : iiuwgraph function : integer;
\r
449 var X,Y,i, OrdN, j : integer,
\r
450 Number : arrayof integer;
\r
451 (* i - liczba wprowadzonych znakow *)
\r
453 array Number dim( 1 : 4 );
\r
459 if i = 4 or (OrdN < 48 and OrdN > 57) then exit fi;
\r
482 when 8 :if i>0 then
\r
486 when 13 :if i > 0 then exit fi ;
\r
490 if Number( 1 ) <> 0 then
\r
493 call hascii(48+Number( 1 ));
\r
499 call Move( X + 8, Y );
\r
501 call hascii( 48 + Number( 2 ));
\r
506 if Number( 1 ) = 0 and Number( 2 ) = 0 then
\r
513 if i = 1 then result := Number( 1 );
\r
515 result := 10 * Number( 1 ) + Number ( 2 );
\r
522 unit WriteInteger:iiuwgraph procedure(Number:integer);
\r
525 if Number < 10 then
\r
527 call HASCII( Number + 48 );
\r
531 j:=(Number - (i * 10));
\r
533 call HASCII( i + 48 );
\r
535 call HASCII( j + 48 );
\r
539 (* FIN DES UNITES DE LECTURE ET ECRITURE EN MODE GRAPHIQUE *)
\r
542 (* SAISIE D'UN ELEMENT *)
\r
543 unit saisie : iiuwgraph procedure(output nombre:integer);
\r
546 call move(200,100);
\r
547 call outstring("ENTREZ UN ENTIER : ");
\r
548 nombre:=readinteger;
\r
552 (* AFFICHAGE DU MENU PRINCIPAL *)
\r
553 unit menu:iiuwgraph procedure(output chx:integer);
\r
558 call outstring("IMPLEMENTATION DES ARBRES BICOLORES");
\r
559 call move(280,100);
\r
560 call outstring("MENU PRINCIPAL");
\r
561 call move(200,140);
\r
562 call outstring("INSERTION : 1");
\r
563 call move(200,160);
\r
564 call outstring("SUPPRESSION : 2");
\r
565 call move(200,180);
\r
566 call outstring("VISUALITION DE L'ARBRE : 3");
\r
567 call move(200,200);
\r
568 call outstring("RECHERCHE D'UN ELEMENT : 4");
\r
569 call move(200,220);
\r
570 call outstring("RECHERCHE DU MININUM : 5");
\r
571 call move(200,240);
\r
572 call outstring("RECHERCHE DU MAXIMUM : 6");
\r
573 call move(200,260);
\r
574 call outstring("FIN DU TRAITEMENT : 9");
\r
575 call move(200,300);
\r
576 call outstring(" VOTRE CHOIX : ");
\r
581 (* AFFICHAGE DE L'ARBRE *)
\r
582 unit visua: procedure(t:noeud;input coeff:real,sup:real,inf:real,niveau:integer);
\r
583 var posx:real,posy,i,j:integer;
\r
585 pref iiuwgraph block
\r
589 posx:=(coeff*(sup-inf))+inf;
\r
592 (*call move(inxpos+8,inypos+8);*)
\r
593 call draw(posx*640,posy);
\r
594 (*call move(inxpos-8,inypos-8);*)
\r
596 call move(round(posx*640),posy);
\r
598 (*call writeinteger(t.elem);*)
\r
599 (*call HASCII(t.elem+48);*)
\r
600 call move(inxpos+4,inypos);
\r
601 if t.couleur=1 then call color(12);
\r
602 else call color(7);
\r
606 call HASCII(t.elem+48);
\r
617 call move(inxpos-20,inypos);
\r
618 call visua(t.gauche,0.5,posx,inf,niveau);
\r
619 call move(round(posx*640)+8,posy+8);
\r
620 call visua(t.droite,0.5,sup,posx,niveau);
\r
621 call move(round(posx*640)+8,posy+8);
\r
629 (* PROGRAMME PRINCIPAL *)
\r
632 var choix,a,trouve,i,ligne:integer,
\r
633 x,z,racine,min,max,pnteur,remp:noeud,
\r
638 pref iiuwgraph block (* UTILISATION DU MODE GRAPHIQUE SUR ECRAN EGA/VGA *)
\r
652 call move(200,100);
\r
656 call insert_bst(a,racine,x,racine,trouve);
\r
658 then call insert(x,racine);
\r
661 call move(200,100);
\r
663 call recherche(racine,a,pnteur);
\r
666 call suppression(racine,pnteur,remp);
\r
668 when 3 : if racine<>z then
\r
670 call visua(racine,0.5,1,0,0);
\r
673 call move(200,100);
\r
674 call outstring(" ARBRE VIDE ");
\r
678 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ... ");
\r
681 call move(200,100);
\r
683 call recherche(racine,a,pnteur)
\r
686 if racine.gauche<>z
\r
687 then min:=recmin(racine.gauche);
\r
690 call move(200,100);
\r
691 call outstring("LE MININUM DE L'ARBRE EST: ");
\r
692 call WriteInteger(min.elem);
\r
694 call move(200,100);
\r
695 call outstring("OPERATION IMPOSSIBLE : ARBRE VIDE ");
\r
697 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ...");
\r
702 if racine.droite<>z
\r
703 then max:=recmax(racine.droite);
\r
706 call move(200,100);
\r
707 call outstring("LE MAXIMUM DE L'ARBRE EST: ");
\r
708 call WriteInteger(max.elem);
\r
710 call move(200,100);
\r
711 call outstring("OPERATION IMPOSSIBLE : ARBRE VIDE ");
\r
714 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ... ");
\r