program BARBRES;


unit barbre:class;
  var  NB:integer,
       inf:barbre,
       page:arrayof couple;

  unit couple:class;
    var cle:integer,
      sup:barbre;
  end couple;

end barbre;



begin

  pref barbre block

    var  n,cherche,choix     : integer,
         rep,h               : boolean,
         racine,q            : barbre,
         u                   : couple;



                      (**** RECHERCHE DU MINIMUM ****)

unit minimum:function(racine:barbre):integer;

 begin
  if (racine.inf = none)
    then result:=racine.page(1).cle
    else result:=minimum(racine.inf)
  fi;
 end minimum;

                      (**** RECHERCHE DU MAXIMUM ****)

 unit maximum:function(racine:barbre):integer;

   begin
     if (racine.inf = none)
      then result := racine.page(racine.nb).cle;
      else result := maximum(racine.page(racine.nb).sup);
     fi;
   end maximum;


                      (**** RECHERCHE D'UN ELEMENT ****)

 unit rechercher:function(cherche:integer;tree:barbre):boolean;
     var left,right,milieu:integer;

 begin
     if (tree=none) then result:=false else
       left:=1;right:=tree.NB;
       while (left<=right) and (right>=1)

   (* RECHERCHE DICHOTOMIQUE  *)
         do
           milieu:=(left+right) div 2;
           if (cherche<tree.page(milieu).cle) then right:=milieu-1;fi;
           if (cherche>tree.page(milieu).cle)  then left:=milieu+1;fi;
           if (cherche=tree.page(milieu).cle) then result:=true;exit;fi;
        od;
        if (not result) then

    (* RECHERCHE DE L'ELEMENT AU NIVEAU SUIVANT *)
            if (right=0)
              then result:=rechercher(cherche,tree.inf);
              else result:=rechercher(cherche,tree.page(right).sup);
            fi;
        fi;
     fi;
 end rechercher;


                      (****  INSERTION D'UN ELEMENT  ****)

 unit recherche_place:procedure(tree:barbre;cherche:integer;
                                output h:boolean,v:couple);
     var left,right,milieu:integer,
         q:barbre,
         u:couple;


   unit insere_deborde:procedure;

(* INSERTION DE L'ELEMENT ET TRAITEMENT DES EVENTUELS DEBORDEMENTS *)

     var i:integer,
      t:arrayof couple,
      b:barbre;
 begin
  if (tree.nb < 2*n )
  then
  (* INSERTION DANS LE CAS OU IL N'Y A PAS DE DEBORDEMENT *)

       tree.nb := tree.nb + 1;
       h:=false; (* IL N'Y A PAS DEBORDEMENT DONC ON MET H A FALSE *)
       for i:= tree.nb downto (right+2) do tree.page(i):=tree.page(i-1) od;
       tree.page(right+1):=u;
  else

   (* INSERTION DANS LE CAS OU IL Y A DEBORDEMENT *)

       b:=new barbre;
       array b.page dim (1:2*n);
       if (right <= n) then
          if (right=n) then v:=u;
          else v:=tree.page(n);
               for i:=  n downto (right +2) do tree.page(i):=tree.page(i-1) od;
               tree.page(right+1):=u;
          fi;
          for i:= 1 to n do b.page(i):=tree.page(i+n) od;
       else
          right:= right - n;
          v:= tree.page(n+1);
          for i := 1 to (right-1) do b.page(i) := tree.page(i+n+1) od;
          b.page(right):=u;
          for i := right+1 to n do b.page(i) := tree.page(i+n) od;
       fi;
       tree.nb:=n;
       b.nb:=n;
       b.inf:=v.sup;
       v.sup:=b;
  fi;

 end insere_deborde;

 begin
     if(tree=none) then

     (* CAS ON A DEPASSE LES FEUILLES, OU BIEN L'ARBRE EST VIDE *)

                     h:=true;
                     v:= new couple;
                     v.cle:=cherche;
     else

     (* RECHERCHE DE LA PLACE OU INSERER AU NIVEAU SUIVANT *)

       left:=1;right:=tree.NB;
       while (left<=right) and (right>=1)
         do
           milieu:=(left+right) div 2;
           if (cherche<tree.page(milieu).cle) then right:=milieu-1;fi;
           if (cherche>tree.page(milieu).cle)  then left:=milieu+1;fi;
           if (cherche=tree.page(milieu).cle) then
              writeln("  L'element ",cherche," est deja dans l'arbre");
              exit;
           fi;
        od;
       if (left=right) then  h:=false;
       else
       (* APPELS RECURSIFS DE LA PROCEDURE RECHERCHE  *)
          if (right=0)
          then call recherche_place(tree.inf,cherche,h,u);
          else call recherche_place(tree.page(right).sup,cherche,h,u);;
          fi;

  (* L'INSTRUCTION QUI SUIT N'EST EFFECTUEE QUE LORS DU DEPILAGE
     DE L'APPEL PRECEDENT DE LA PROCEDURE RECHERCHE_PLACE. SI IL Y A
     DEBORDEMENT APRES L'APPEL DE INSERE_DEBORDE, ALORS H GARDE LA VALEUR
     TRUE ET ON FAIT UN APPEL DE INSERE_DEBORDE SUR LE NIVEAU PRECEDENT
     GRACE AU DEPILLAGE DES APPELS DE RECHERCHE_PLACE *)

        if (h) then call insere_deborde fi;
       fi;
     fi;
 end recherche_place;


 unit inserer:procedure(x:integer;inout racine:barbre);

 begin
   call recherche_place(racine,x,h,u);

 (* CAS OU L'ARBRE EST VIDE, OU CAS OU IL FAUT CREER UNE NOUVELLE RACINE,
   LE DEBORDEMENT AYANT ATTEINT LA RACINE *)

   if (h) then q:=racine;
       racine:=new barbre;
       array racine.page dim (1:2*n);
       racine.nb:=1;
       racine.inf:=q;
       racine.page(1):=u;
    fi;
 end inserer;


                      (****  VISUALISATION  ****)

 unit visualise:procedure( b_arb:barbre;separe:integer);

(* VISUALISATION DES ELEMENTS PAR APPELS RECURSIFS SUR L'ARBRE *)
  var i:integer;

 begin
  if (b_arb <> none)
     then
      for i:= 1 to separe  do write("   ") od;
      for i:= 1 to b_arb.nb do write(b_arb.page(i).cle:5) od;
      writeln;
      call visualise(b_arb.inf,separe+1);
      for i:= 1 to b_arb.nb do call visualise(b_arb.page(i).sup,separe+1) od;
  fi;
 end visualise;


                      (****  SAUTER n LIGNES A L ECRAN  ****)

 unit ligne:procedure(n:integer);
  var i : integer;
 begin
   for i := 1 to n do writeln od;
 end ligne;


                      (****  MENU  ****)

 unit menu: procedure(output choix:integer);
 begin
     call ligne(30);
     write("                MANIPULATION DE B-ARBRE ");
     writeln;
     write("                   1 : recherche de l'element minimum ");
     writeln;
     write("                   2 : recherche de l'element maximun ");
     writeln;
     write("                   3 : recherche d'un element quelconque");
     writeln;
     write("                   4 : Insertion d'un element dans l'arbre ");
     writeln;
     write("                   5 : Visualisation de l'arbre");
     writeln;
     write("                   6 : Quitter le programme ");
     call ligne(9);
     write("                        Entrer votre choix : ");
     readln(choix);
     writeln;
 end menu;

                   (****  PASSAGE AU MENU SUIVANT  ****)

unit continuer : procedure;

(* PERMET DE "FIGER" L'ECRAN POUR LIRE LE RESULTAT *)

 var c : char;
  begin
    writeln;
    writeln;
    write(" Pour continuer appuyez deux fois sur 'entree' :");
    readln(c);
  end continuer;


       (* -----------------  PROGRAMME PRINCIPAL -------------------  *)


 begin
   rep := true;
   call ligne(30);
   write("                     ENTRER L'ORDRE DE L'ARBRE :");
   readln(n);

   while rep do
      call menu(choix);

      case choix

      (* APPEL DE LA PROCEDURE CHERCHANT LE MINIMUM *)
          when 1 : call ligne(30);
           if (racine = none)
           then writeln("                         L' ARBRE EST VIDE !!!");
           else
            write("                            LE MINIMUM EST ", minimum(racine):2);
           fi;
           call ligne(11);
           call continuer;

      (* APPEL DE LA PROCEDURE CHERCHANT LE MAXIMUM *)
          when 2 : call ligne(11);
           if (racine = none )
             then
              writeln("                         L' ARBRE EST VIDE !!!");
             else
              write("                           LE MAXIMUM EST ", maximum(racine):2);
           fi;
           call ligne(11);
           call continuer;

      (* APPEL DE LA PROCEDURE CHERCHANT UN ELEMENT QUELCONQUE *)
          when 3 : write(" ENTRER L'ELEMENT A CHERCHER :");
           readln(cherche);
           writeln;
           call ligne(30);
           if (rechercher(cherche,racine))
             then
             writeln("                    L'ELEMENT ",cherche :2," SE TROUVE DANS L'ARBRE");
             else
             writeln("                    L'ELEMENT ",cherche:2," N'EST PAS DANS L'ARBRE");
           fi;
           call ligne(11);
           call continuer;

      (* APPEL DE LA PROCEDURE INSERANT UN ELEMENT *)
          when 4 : write(" ENTRER L'ELEMENT A INSERER :");
           readln(cherche);
           call inserer (cherche,racine);

      (* APPEL DE LA PROCEDURE VISUALISANT UN ARBRE *)
          when 5:
            if (racine = none)
              then call ligne(30);
                   writeln("                         L'ARBRE EST VIDE .");
                   call ligne(11);
              else writeln(" L'arbre est : ");
                   call visualise(racine,1);
            fi;
            call continuer;

       (* SORTIE DU PROGRAMME *)
          when 6: rep:= false;
       esac;
   od;

end;
end BARBRES.