program bicolore;


(* ANNEE UNIVERSITAIRE 1993/1994 : Universit‚ de Pau                    *)

(* DATE DE REMISE : 15 JANVIER 1994                                     *)
(*                                                                      *)
(* SUJET : ARBRES BICOLORES                                             *)
(*                                                                      *)
(*      GROUPE 2 , LICENCE INFORMATIQUE , LI1                           *)
(*                                                                      *)
(*                                                                      *)
(*      MARIE HEGUY                                                     *)
(*      JACQUES LATAPIE                                                 *)

(*      SUJET PROPOSE PAR MME MIRKOWSKA                                 *)


unit noeud:class;
var elem:integer,gauche,droite,pere:noeud,couleur:integer;
end noeud;


(* RECHERCHE DU MINIMUN *)
unit recmin:function(t:noeud):noeud;
begin
if t.gauche=z then result:=t;
              else result:=recmin(t.gauche);
fi;
end recmin;


(* RECHERCHE DU MAXIMUM *)
unit recmax:function(t:noeud):noeud;
begin
if t.droite=z then result:=t;
              else result:=recmax(t.droite);
fi;
end recmax;


(* SUPPRESSION D'UN ELEMENT COMME DANS UN ARBRE BST *)
unit suppression:iiuwgraph procedure(inout t:noeud,supp:noeud,remplacant:noeud);
var locale:noeud;
begin
if supp.gauche=z or supp.droite=z
    then remplacant:=supp;
    else remplacant:=recmin(supp.droite);
fi;
if remplacant.gauche<>z
   then locale:=remplacant.gauche;
   else locale:=remplacant.droite;
fi;
locale.pere:=remplacant.pere;
if remplacant.pere=remplacant
    then t:=locale;
         t.pere:=t;
    else if remplacant=remplacant.pere.gauche
         then remplacant.pere.gauche:=locale;
         else remplacant.pere.droite:=locale;
         fi;
fi;
if remplacant<>supp then supp.elem:=remplacant.elem;fi;
if remplacant.couleur=0 then call suppresmaj(t,locale);fi;
end suppression;


(* ROTATION ET INVERSION DES COULEURS APRES SUPPRESSION *)
unit suppresmaj:iiuwgraph procedure(inout t:noeud,rond:noeud);
var local:noeud,rep:integer;
begin
while rond<>t and rond.couleur=0
do
        if rond=rond.pere.gauche
        then 
            local:=rond.pere.droite;
            if local.couleur=1
               then
                   local.couleur:=0;
                   rond.pere.couleur:=1;
                   call gauch(t,rond.pere);
                   call cls;
                   call visua(t,0.5,1,0,0);
                   call color(14);
                   call move(2,340);
                   call outstring("Visua. aprŠs rot. Gauche  sur ");
                   call writeinteger(rond.pere.elem);
                   call outstring(" <RETURN> ");
                   rep:=inchar;
                   call cls;
                   local:=rond.pere.droite;
            fi;
            if local.gauche.couleur=0 and local.droite.couleur=0
               then
                   local.couleur:=1;
                   rond:=rond.pere;
               else
                   if local.droite.couleur=0 
                      then local.gauche.couleur:=0;
                           local.couleur:=1;
                           call droit(t,local);
                           call cls;
                           call visua(t,0.5,1,0,0);
                           call color(14);
                           call move(2,340);
                           call outstring("Rotation Droite sur ");
                           call writeinteger(local.elem);
                           call outstring(" <RETURN> ");
                           rep:=inchar;
                           call cls;
                           local:=rond.pere.droite;
                   fi;
                   local.couleur:=rond.pere.couleur;
                   rond.pere.couleur:=0;
                   local.droite.couleur:=0;
                   call gauch(t,rond.pere);
                   call cls;
                   call visua(t,0.5,1,0,0);
                   call color(14);
                   call move(2,340);
                   call outstring("Rotation Gauche sur ");
                   call writeinteger(rond.pere.elem);
                   call outstring(" <RETURN> ");
                   rep:=inchar;
                   call cls;
                   rond:=t;
               fi;
        else
                local:=rond.pere.gauche;
                if local.couleur=1
                   then
                      local.couleur:=0;
                      rond.pere.couleur:=1;
                      call droit(t,rond.pere);
                      call cls;
                      call visua(t,0.5,1,0,0);
                      call color(14);
                      call move(2,340);
                      call outstring("Rotation Droite sur ");
                      call writeinteger(rond.pere.elem);
                      call outstring(" <RETURN> ");
                      rep:=inchar;
                      call cls;
                      local:=rond.pere.gauche;
                fi;
                if local.droite.couleur=0 and local.gauche.couleur=0
                   then
                      local.couleur:=1; 
                      rond:=rond.pere;
                   else
                      if local.gauche.couleur=0
                         then
                             local.droite.couleur:=0;
                             local.couleur:=1;
                             call gauch(t,local);
                             call cls;
                             call visua(t,0.5,1,0,0);
                             call color(14);
                             call move(2,340);
                             call outstring("Rotation Gauche sur ");
                             call writeinteger(local.elem);
                             call outstring(" <RETURN> ");
                             rep:=inchar;
                             call cls;
                             local:=rond.pere.gauche;
                      fi;
                      local.couleur:=rond.pere.couleur;
                      rond.pere.couleur:=0;
                      local.gauche.couleur:=0;
                      call droit(t,rond.pere);
                      call cls;
                      call visua(t,0.5,1,0,0);
                      call color(14);
                      call move(2,340);
                      call outstring("Rotation Droite sur ");
                      call writeinteger(rond.pere.elem);
                      call outstring(" <RETURN> ");
                      rep:=inchar;
                      call cls;
                      rond:=t;
                fi;
        fi;
od;
rond.couleur:=0;
end suppresmaj;


(* INSERSION COMME DANS UN ARBRE BST *)
unit insert_bst: procedure(nb:integer;inout r:noeud,x:noeud,p:noeud,trouve:integer);
begin
if r.elem=nb then
                if r=z then
                r:=new noeud;
                r.elem:=nb;
                if p=z then r.pere:=r;
                        else r.pere:=p;
                fi;
                r.droite:=z;
                r.gauche:=z;
                x:=r;
                else
                (*("CET ELEMENT EST DEJA INSERE !!! ");*)
                trouve:=1;
                fi;
else
        if nb<r.elem then call insert_bst(nb,r.gauche,x,r,trouve);
                     else call insert_bst(nb,r.droite,x,r,trouve);
        fi;
fi;
end insert_bst;


(* ROTATIONS ET CHANGEMENTS DE COULEURS APRES INSERSION *)
unit insert:iiuwgraph procedure(inout x:noeud;inout racine:noeud);
var y,valeur:noeud,rep:integer;
begin
call cls;
call color(14);
x.couleur:=1;
while ((x<>racine) and (x.pere.couleur=1))
do
call cls;
call visua(racine,0.5,1,0,0);
call color(14);
call move(2,340);
call outstring("On a deux noeuds rouges cons‚cutifs ");
call writeinteger(x.elem);
call outstring(" et ");
call writeinteger(x.pere.elem);
call outstring(" <RETURN> ");
rep:=inchar;
call cls;
if x.pere=x.pere.pere.gauche 
then 
    y:=x.pere.pere.droite;
    if y.couleur=1
    then
        (* L'oncle de x.elem est rouge donc inversion des couleurs*)
        x.pere.couleur:=0;
        y.couleur:=0;
        x.pere.pere.couleur:=1;
        call visua(racine,0.5,1,0,0);
        call color(14);
        call move(2,340);
        call outstring("Visualisation aprŠs inversion des couleur <RETURN> ");
        rep:=inchar;
        call cls;
        x:=x.pere.pere;
    else
        if x=x.pere.droite 
        then
                x:=x.pere;
                call gauch(racine,x);
                call cls;
                call visua(racine,0.5,1,0,0);
                call color(14);
                call move(2,340);
                call outstring("Visualisation aprŠs rot. gauche au niveau de ");
                call writeinteger(x.elem);
                call outstring(" <RETURN> ");
                rep:=inchar;
                call cls;
        fi;
        x.pere.couleur:=0;
        x.pere.pere.couleur:=1;
        if x.pere.pere=racine 
                then valeur:=x.pere;
                else valeur:=x.pere.pere.pere;
        fi;
        call droit(racine,x.pere.pere);
        x.pere.pere:=valeur;
        call cls;
        call visua(racine,0.5,1,0,0);
        call color(14);
        call move(2,340);
        call outstring("Visu.apŠs r‚tab. des couleurs et rot. D sur ");
        call writeinteger(x.pere.pere.elem);
        call outstring(" <RETURN> ");
        rep:=inchar;
        call cls;
    fi;
else
    y:=x.pere.pere.gauche;
    if y.couleur=1
    then
        (* L'oncle de x.elem est rouge donc inversion des couleurs*)
        x.pere.couleur:=0;
        y.couleur:=0;
        x.pere.pere.couleur:=1;
        call cls;
        call visua(racine,0.5,1,0,0);
        call color(14);
        call move(2,340);
        call outstring("Visua. aprŠs inversion des couleurs <RETURN>");
        rep:=inchar;
        call cls;
        x:=x.pere.pere;
    else
       if x=x.pere.gauche
       then
           x:=x.pere;
           call droit(racine,x);
           call cls;
           call visua(racine,0.5,1,0,0);
           call move(2,340);
           call color(14);
           call outstring("Visualisation aprŠs rotation droite au niveau de ");
           call writeinteger(x.elem);
           call outstring("  <RETURN>  ");
           rep:=inchar;
           call cls;
       fi;
       x.pere.couleur:=0;
       x.pere.pere.couleur:=1;
       if x.pere.pere=racine 
           then valeur:=x.pere;
           else valeur:=x.pere.pere.pere;
       fi;
       call gauch(racine,x.pere.pere);
       x.pere.pere:=valeur;
       call cls;
       call visua(racine,0.5,1,0,0);
       call move(2,340);
       call color(14);
       call outstring("Visu.aprŠs r‚tab. des  couleurs et rot. gauche sur  ");
       call writeinteger(x.pere.pere.elem);
       call outstring(" <RETURN> ");
       rep:=inchar;
       call cls;
    fi;
fi;
od;
racine.couleur:=0;
end insert;


(* ROTATION GAUCHE *)
unit gauch:procedure(inout t:noeud;inout aux1:noeud);
var fils:noeud;
begin
fils:=aux1.droite;
aux1.droite:=fils.gauche;
if aux1<>t then fils.pere:=aux1.pere;
        else fils.pere:=fils;
fi;
if fils.gauche<>z then fils.gauche.pere:=aux1;fi;
if aux1.pere=aux1 then t:=fils;
else
    if aux1=aux1.pere.gauche
    then
       aux1.pere.gauche:=fils;
    else
       aux1.pere.droite:=fils; 
    fi;    
fi;
fils.gauche:=aux1;
aux1.pere:=fils;
end gauch;


(* ROTATION DROITE *)

unit droit:procedure(inout t:noeud;inout aux2:noeud);
var child:noeud;
begin
child:=aux2.gauche;
aux2.gauche:=child.droite;
if child.droite<>z then child.droite.pere:=aux2;fi;
if aux2<>t then child.pere:=aux2.pere;
        else child.pere:=child;
fi;
if aux2.pere=aux2 then t:=child;
else
    if aux2=aux2.pere.droite
    then aux2.pere.droite:=child;
    else aux2.pere.gauche:=child;
    fi;
fi;
child.droite:=aux2;
aux2.pere:=child;
end droit;


(* RECHERCHE D'UN ELEMENT QUELCONQUE *)
unit recherche: iiuwgraph procedure(r:noeud;nb:integer;inout pointeur:noeud);
var rep:integer;
begin
while r<>z 
do
        call cls;
        call move(200,100);
        if r.elem=nb then call outstring("Element ");
                          call writeinteger(nb);
                          call outstring(" est trouv‚ dans l'arbre");
                          call move(200,120);
                          call outstring(" COULEUR = ");
                          if r.couleur=1 then
                             call outstring(" ROUGE ");
                          else call outstring(" NOIR ");
                          fi;
                          call move(200,140);
                          call outstring(" PERE = ");
                          call writeinteger(r.pere.elem);
                          call move(200,160);
                          if r.gauche<>z then call outstring("FILS GAUCHE = ");
                                              call writeinteger(r.gauche.elem);fi;
                          call move(200,180);
                          if r.droite<>z then call outstring("FILS DROIT = ");
                                              call writeinteger(r.droite.elem);fi;
                          call move(0,340);
                          call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER .. ");
                          rep:=inchar;
                          pointeur:=r;
                          return;
                     else
                        if nb>r.elem then r:=r.droite;
                                     else r:=r.gauche;
                        fi;
        fi;
od;
if r=z then 
            call move(200,160);
            call writeinteger(nb);
            call outstring(" N'APPARTIENT PAS A L'ARBRE ");
            call move(0,340);
            call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ...");
            rep:=inchar;
            pointeur:=z;
fi;
end recherche;



(* PROCEDURES ET FONCTIONS UTILISANT LE MODE GRAPHIQUE *)

unit inchar: iiuwgraph function:integer;
var i:integer;
begin
   do
      i:=inkey;
      if i=/=0 then exit fi;
   od;
   result:=i;
end inchar;


unit ReadInteger : iiuwgraph function : integer;
  var  X,Y,i, OrdN, j : integer,
               Number : arrayof integer;
(* i - liczba wprowadzonych znakow  *)
  begin
    array Number dim( 1 : 4 );
    i:= 0 ;
    X := InXPos;
    Y := InYPos;
    do
      OrdN:=inchar;
      if i = 4 or (OrdN < 48 and OrdN > 57) then exit fi;
 
      case OrdN
        when 48    :i:=i+1;
                    Number(i):=0;
        when 49    :i:=i+1;
                    Number(i):=1;
        when 50    :i:=i+1;
                    Number(i):=2;
        when 51    :i:=i+1;
                    Number(i):=3;
        when 52    :i:=i+1;
                    Number(i):=4;
        when 53    :i:=i+1;
                    Number(i):=5;
        when 54    :i:=i+1;
                    Number(i):=6;
        when 55    :i:=i+1;
                    Number(i):=7;
        when 56    :i:=i+1;
                    Number(i):=8;
        when 57    :i:=i+1;
                    Number(i):=9;
        when  8    :if i>0 then
                      Number( i ) := 0;
                      i := i - 1;
                    fi;
        when 13    :if i > 0 then exit fi ;
 
      esac;
 
      if Number( 1 ) <> 0 then
        call Move( X,Y );
        call hascii( 0 );
        call hascii(48+Number( 1 ));
        call hascii( 0 );
 
      fi;
 
      if i = 2 then
        call Move( X + 8, Y  );
        call hascii( 0 );
        call hascii( 48 + Number( 2 ));
        call hascii( 0 );
      fi;
   od;
 
   if Number( 1 ) = 0 and Number( 2 ) = 0 then
     call Move( X,Y );
     call hascii( 0 );
     call hascii( 48 );
     call hascii( 0 );
   fi;
 
   if i = 1 then result := Number( 1 );
   else
     result := 10 * Number( 1 ) + Number ( 2 );
   fi;
   kill( Number );
  end ReadInteger;
 


unit WriteInteger:iiuwgraph procedure(Number:integer);
var i,j:integer;
begin
    if Number < 10 then
       call HASCII( 0 );
       call HASCII( Number + 48 );
       call HASCII( 0 );
    else
      i:=Number div 10;
      j:=(Number - (i * 10));
      call HASCII(0);
      call HASCII( i + 48 );
      call HASCII(0);
      call HASCII( j + 48 );
   fi;
end WriteInteger;

(* FIN DES UNITES DE LECTURE ET ECRITURE EN MODE GRAPHIQUE *)


(* SAISIE D'UN ELEMENT  *)
unit saisie : iiuwgraph procedure(output nombre:integer);
begin
      call cls;
      call move(200,100);
      call outstring("ENTREZ UN ENTIER : ");
      nombre:=readinteger;
end;


(*  AFFICHAGE DU MENU PRINCIPAL *)
unit menu:iiuwgraph procedure(output chx:integer);
begin
   call cls;
   call color(14);
   call move(180,50);
   call outstring("IMPLEMENTATION DES ARBRES BICOLORES");
   call move(280,100);
   call outstring("MENU PRINCIPAL");
   call move(200,140);
   call outstring("INSERTION               : 1");
   call move(200,160);
   call outstring("SUPPRESSION             : 2");
   call move(200,180);
   call outstring("VISUALITION DE L'ARBRE  : 3");
   call move(200,200);
   call outstring("RECHERCHE D'UN ELEMENT  : 4");
   call move(200,220);
   call outstring("RECHERCHE DU MININUM    : 5");
   call move(200,240);
   call outstring("RECHERCHE DU MAXIMUM    : 6");
   call move(200,260);
   call outstring("FIN DU TRAITEMENT       : 9");
   call move(200,300);
   call outstring("    VOTRE CHOIX : ");
   chx:=readinteger;
end;


(* AFFICHAGE DE L'ARBRE *)
unit visua: procedure(t:noeud;input coeff:real,sup:real,inf:real,niveau:integer);
var posx:real,posy,i,j:integer;
begin
   pref iiuwgraph block
   begin
   if t=/= z then
      niveau:=niveau+1;
      posx:=(coeff*(sup-inf))+inf;
      posy:=(niveau*35);
      if niveau=/=1 then
         (*call move(inxpos+8,inypos+8);*)
         call draw(posx*640,posy);
         (*call move(inxpos-8,inypos-8);*)
      fi;
      call move(round(posx*640),posy);
      call HASCII(0);
      (*call writeinteger(t.elem);*)
      (*call HASCII(t.elem+48);*)
      call move(inxpos+4,inypos);
      if t.couleur=1 then call color(12);
                     else call color(7);
      fi;
      if t.elem<10 then
         call HASCII(0);
         call HASCII(t.elem+48);
         call HASCII(0);
      else
         i:=t.elem div 10;
         j:=t.elem-i*10;
         call HASCII(0);
         call HASCII(i+48);
         call HASCII(0);
         call HASCII(j+48);
      fi;
      call color(1);
      call move(inxpos-20,inypos);
      call visua(t.gauche,0.5,posx,inf,niveau);
      call move(round(posx*640)+8,posy+8);
      call visua(t.droite,0.5,sup,posx,niveau);
      call move(round(posx*640)+8,posy+8);
   fi;
   end;
end visua;




(* PROGRAMME PRINCIPAL *)


var choix,a,trouve,i,ligne:integer,
    x,z,racine,min,max,pnteur,remp:noeud,
    rp:char;


BEGIN
pref iiuwgraph block (* UTILISATION DU MODE GRAPHIQUE SUR ECRAN EGA/VGA *)
begin

z:=new noeud;
choix:=0;
z.couleur:=0;
racine:=z;
call gron(5);

while (choix<>9)
do
call menu(choix);
        case choix
        when 1 : call cls;
                 call move(200,100);
                 call saisie(a);
                 z.elem:=a;
                 trouve:=0;
                 call insert_bst(a,racine,x,racine,trouve);
                 if trouve=0
                    then call insert(x,racine);
                 fi
        when 2 : call cls;
                 call move(200,100);
                 call saisie(a);
                 call recherche(racine,a,pnteur);
                 if pnteur<>z 
                    then
                       call suppression(racine,pnteur,remp);
                 fi;
        when 3 : if racine<>z then
                    call cls;
                    call visua(racine,0.5,1,0,0);
                 else
                    call cls;
                    call move(200,100);
                    call outstring(" ARBRE VIDE ");
                 fi;
                 call color(14);
                 call move(0,340);
                 call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ... ");
                 rp:=chr(inchar)
        when 4 : call cls;
                 call move(200,100);
                 call saisie(a);
                 call recherche(racine,a,pnteur)
        when 5 : call cls;
                 if racine<>z then
                    if racine.gauche<>z 
                       then min:=recmin(racine.gauche);
                       else min:=racine;
                    fi;
                    call move(200,100); 
                    call outstring("LE MININUM DE L'ARBRE EST: ");
                    call WriteInteger(min.elem);
                 else
                    call move(200,100);
                    call outstring("OPERATION IMPOSSIBLE : ARBRE VIDE ");
                    call move(0,340);
                    call outstring("APPUYEZ SUR <RETURN> POUR CONTINUER ...");
                 fi;
                 rp:=chr(inchar)
        when 6 : call cls;
                 if racine<>z then
                    if racine.droite<>z
                       then max:=recmax(racine.droite);
                       else max:=racine;
                    fi;
                    call move(200,100);
                    call outstring("LE MAXIMUM DE L'ARBRE EST: ");
                    call WriteInteger(max.elem);
                 else
                    call move(200,100);
                    call outstring("OPERATION IMPOSSIBLE : ARBRE VIDE ");
                 fi;
                 call move(0,340);
                 call outstring("APPUYEZ SUR  <RETURN> POUR CONTINUER ... ");
                 rp:=chr(inchar);
        esac;
od;

call groff;
call endrun;
end;

END bicolore;