projet.log

   1 program BARBRES;\r
   2 \r
   3 \r
   4 unit barbre:class;\r
   5   var  NB:integer,\r
   6        inf:barbre,\r
   7        page:arrayof couple;\r
   8 \r
   9   unit couple:class;\r
  10     var cle:integer,\r
  11       sup:barbre;\r
  12   end couple;\r
  13 \r
  14 end barbre;\r
  15 \r
  16 \r
  17 \r
  18 begin\r
  19 \r
  20   pref barbre block\r
  21 \r
  22     var  n,cherche,choix     : integer,\r
  23          rep,h               : boolean,\r
  24          racine,q            : barbre,\r
  25          u                   : couple;\r
  26 \r
  27 \r
  28 \r
  29                       (**** RECHERCHE DU MINIMUM ****)\r
  30 \r
  31 unit minimum:function(racine:barbre):integer;\r
  32 \r
  33  begin\r
  34   if (racine.inf = none)\r
  35     then result:=racine.page(1).cle\r
  36     else result:=minimum(racine.inf)\r
  37   fi;\r
  38  end minimum;\r
  39 \r
  40                       (**** RECHERCHE DU MAXIMUM ****)\r
  41 \r
  42  unit maximum:function(racine:barbre):integer;\r
  43 \r
  44    begin\r
  45      if (racine.inf = none)\r
  46       then result := racine.page(racine.nb).cle;\r
  47       else result := maximum(racine.page(racine.nb).sup);\r
  48      fi;\r
  49    end maximum;\r
  50 \r
  51 \r
  52                       (**** RECHERCHE D'UN ELEMENT ****)\r
  53 \r
  54  unit rechercher:function(cherche:integer;tree:barbre):boolean;\r
  55      var left,right,milieu:integer;\r
  56 \r
  57  begin\r
  58      if (tree=none) then result:=false else\r
  59        left:=1;right:=tree.NB;\r
  60        while (left<=right) and (right>=1)\r
  61 \r
  62    (* RECHERCHE DICHOTOMIQUE  *)\r
  63          do\r
  64            milieu:=(left+right) div 2;\r
  65            if (cherche<tree.page(milieu).cle) then right:=milieu-1;fi;\r
  66            if (cherche>tree.page(milieu).cle)  then left:=milieu+1;fi;\r
  67            if (cherche=tree.page(milieu).cle) then result:=true;exit;fi;\r
  68         od;\r
  69         if (not result) then\r
  70 \r
  71     (* RECHERCHE DE L'ELEMENT AU NIVEAU SUIVANT *)\r
  72             if (right=0)\r
  73               then result:=rechercher(cherche,tree.inf);\r
  74               else result:=rechercher(cherche,tree.page(right).sup);\r
  75             fi;\r
  76         fi;\r
  77      fi;\r
  78  end rechercher;\r
  79 \r
  80 \r
  81                       (****  INSERTION D'UN ELEMENT  ****)\r
  82 \r
  83  unit recherche_place:procedure(tree:barbre;cherche:integer;\r
  84                                 output h:boolean,v:couple);\r
  85      var left,right,milieu:integer,\r
  86          q:barbre,\r
  87          u:couple;\r
  88 \r
  89 \r
  90    unit insere_deborde:procedure;\r
  91 \r
  92 (* INSERTION DE L'ELEMENT ET TRAITEMENT DES EVENTUELS DEBORDEMENTS *)\r
  93 \r
  94      var i:integer,\r
  95       t:arrayof couple,\r
  96       b:barbre;\r
  97  begin\r
  98   if (tree.nb < 2*n )\r
  99   then\r
 100   (* INSERTION DANS LE CAS OU IL N'Y A PAS DE DEBORDEMENT *)\r
 101 \r
 102        tree.nb := tree.nb + 1;\r
 103        h:=false; (* IL N'Y A PAS DEBORDEMENT DONC ON MET H A FALSE *)\r
 104        for i:= tree.nb downto (right+2) do tree.page(i):=tree.page(i-1) od;\r
 105        tree.page(right+1):=u;\r
 106   else\r
 107 \r
 108    (* INSERTION DANS LE CAS OU IL Y A DEBORDEMENT *)\r
 109 \r
 110        b:=new barbre;\r
 111        array b.page dim (1:2*n);\r
 112        if (right <= n) then\r
 113           if (right=n) then v:=u;\r
 114           else v:=tree.page(n);\r
 115                for i:=  n downto (right +2) do tree.page(i):=tree.page(i-1) od;\r
 116                tree.page(right+1):=u;\r
 117           fi;\r
 118           for i:= 1 to n do b.page(i):=tree.page(i+n) od;\r
 119        else\r
 120           right:= right - n;\r
 121           v:= tree.page(n+1);\r
 122           for i := 1 to (right-1) do b.page(i) := tree.page(i+n+1) od;\r
 123           b.page(right):=u;\r
 124           for i := right+1 to n do b.page(i) := tree.page(i+n) od;\r
 125        fi;\r
 126        tree.nb:=n;\r
 127        b.nb:=n;\r
 128        b.inf:=v.sup;\r
 129        v.sup:=b;\r
 130   fi;\r
 131 \r
 132  end insere_deborde;\r
 133 \r
 134  begin\r
 135      if(tree=none) then\r
 136 \r
 137      (* CAS ON A DEPASSE LES FEUILLES, OU BIEN L'ARBRE EST VIDE *)\r
 138 \r
 139                      h:=true;\r
 140                      v:= new couple;\r
 141                      v.cle:=cherche;\r
 142      else\r
 143 \r
 144      (* RECHERCHE DE LA PLACE OU INSERER AU NIVEAU SUIVANT *)\r
 145 \r
 146        left:=1;right:=tree.NB;\r
 147        while (left<=right) and (right>=1)\r
 148          do\r
 149            milieu:=(left+right) div 2;\r
 150            if (cherche<tree.page(milieu).cle) then right:=milieu-1;fi;\r
 151            if (cherche>tree.page(milieu).cle)  then left:=milieu+1;fi;\r
 152            if (cherche=tree.page(milieu).cle) then\r
 153               writeln("  L'element ",cherche," est deja dans l'arbre");\r
 154               exit;\r
 155            fi;\r
 156         od;\r
 157        if (left=right) then  h:=false;\r
 158        else\r
 159        (* APPELS RECURSIFS DE LA PROCEDURE RECHERCHE  *)\r
 160           if (right=0)\r
 161           then call recherche_place(tree.inf,cherche,h,u);\r
 162           else call recherche_place(tree.page(right).sup,cherche,h,u);;\r
 163           fi;\r
 164 \r
 165   (* L'INSTRUCTION QUI SUIT N'EST EFFECTUEE QUE LORS DU DEPILAGE\r
 166      DE L'APPEL PRECEDENT DE LA PROCEDURE RECHERCHE_PLACE. SI IL Y A\r
 167      DEBORDEMENT APRES L'APPEL DE INSERE_DEBORDE, ALORS H GARDE LA VALEUR\r
 168      TRUE ET ON FAIT UN APPEL DE INSERE_DEBORDE SUR LE NIVEAU PRECEDENT\r
 169      GRACE AU DEPILLAGE DES APPELS DE RECHERCHE_PLACE *)\r
 170 \r
 171         if (h) then call insere_deborde fi;\r
 172        fi;\r
 173      fi;\r
 174  end recherche_place;\r
 175 \r
 176 \r
 177  unit inserer:procedure(x:integer;inout racine:barbre);\r
 178 \r
 179  begin\r
 180    call recherche_place(racine,x,h,u);\r
 181 \r
 182  (* CAS OU L'ARBRE EST VIDE, OU CAS OU IL FAUT CREER UNE NOUVELLE RACINE,\r
 183    LE DEBORDEMENT AYANT ATTEINT LA RACINE *)\r
 184 \r
 185    if (h) then q:=racine;\r
 186        racine:=new barbre;\r
 187        array racine.page dim (1:2*n);\r
 188        racine.nb:=1;\r
 189        racine.inf:=q;\r
 190        racine.page(1):=u;\r
 191     fi;\r
 192  end inserer;\r
 193 \r
 194 \r
 195                       (****  VISUALISATION  ****)\r
 196 \r
 197  unit visualise:procedure( b_arb:barbre;separe:integer);\r
 198 \r
 199 (* VISUALISATION DES ELEMENTS PAR APPELS RECURSIFS SUR L'ARBRE *)\r
 200   var i:integer;\r
 201 \r
 202  begin\r
 203   if (b_arb <> none)\r
 204      then\r
 205       for i:= 1 to separe  do write("   ") od;\r
 206       for i:= 1 to b_arb.nb do write(b_arb.page(i).cle:5) od;\r
 207       writeln;\r
 208       call visualise(b_arb.inf,separe+1);\r
 209       for i:= 1 to b_arb.nb do call visualise(b_arb.page(i).sup,separe+1) od;\r
 210   fi;\r
 211  end visualise;\r
 212 \r
 213 \r
 214                       (****  SAUTER n LIGNES A L ECRAN  ****)\r
 215 \r
 216  unit ligne:procedure(n:integer);\r
 217   var i : integer;\r
 218  begin\r
 219    for i := 1 to n do writeln od;\r
 220  end ligne;\r
 221 \r
 222 \r
 223                       (****  MENU  ****)\r
 224 \r
 225  unit menu: procedure(output choix:integer);\r
 226  begin\r
 227      call ligne(30);\r
 228      write("                MANIPULATION DE B-ARBRE ");\r
 229      writeln;\r
 230      write("                   1 : recherche de l'element minimum ");\r
 231      writeln;\r
 232      write("                   2 : recherche de l'element maximun ");\r
 233      writeln;\r
 234      write("                   3 : recherche d'un element quelconque");\r
 235      writeln;\r
 236      write("                   4 : Insertion d'un element dans l'arbre ");\r
 237      writeln;\r
 238      write("                   5 : Visualisation de l'arbre");\r
 239      writeln;\r
 240      write("                   6 : Quitter le programme ");\r
 241      call ligne(9);\r
 242      write("                        Entrer votre choix : ");\r
 243      readln(choix);\r
 244      writeln;\r
 245  end menu;\r
 246 \r
 247                    (****  PASSAGE AU MENU SUIVANT  ****)\r
 248 \r
 249 unit continuer : procedure;\r
 250 \r
 251 (* PERMET DE "FIGER" L'ECRAN POUR LIRE LE RESULTAT *)\r
 252 \r
 253  var c : char;\r
 254   begin\r
 255     writeln;\r
 256     writeln;\r
 257     write(" Pour continuer appuyez deux fois sur 'entree' :");\r
 258     readln(c);\r
 259   end continuer;\r
 260 \r
 261 \r
 262        (* -----------------  PROGRAMME PRINCIPAL -------------------  *)\r
 263 \r
 264 \r
 265  begin\r
 266    rep := true;\r
 267    call ligne(30);\r
 268    write("                     ENTRER L'ORDRE DE L'ARBRE :");\r
 269    readln(n);\r
 270 \r
 271    while rep do\r
 272       call menu(choix);\r
 273 \r
 274       case choix\r
 275 \r
 276       (* APPEL DE LA PROCEDURE CHERCHANT LE MINIMUM *)\r
 277           when 1 : call ligne(30);\r
 278            if (racine = none)\r
 279            then writeln("                         L' ARBRE EST VIDE !!!");\r
 280            else\r
 281             write("                            LE MINIMUM EST ", minimum(racine):2);\r
 282            fi;\r
 283            call ligne(11);\r
 284            call continuer;\r
 285 \r
 286       (* APPEL DE LA PROCEDURE CHERCHANT LE MAXIMUM *)\r
 287           when 2 : call ligne(11);\r
 288            if (racine = none )\r
 289              then\r
 290               writeln("                         L' ARBRE EST VIDE !!!");\r
 291              else\r
 292               write("                           LE MAXIMUM EST ", maximum(racine):2);\r
 293            fi;\r
 294            call ligne(11);\r
 295            call continuer;\r
 296 \r
 297       (* APPEL DE LA PROCEDURE CHERCHANT UN ELEMENT QUELCONQUE *)\r
 298           when 3 : write(" ENTRER L'ELEMENT A CHERCHER :");\r
 299            readln(cherche);\r
 300            writeln;\r
 301            call ligne(30);\r
 302            if (rechercher(cherche,racine))\r
 303              then\r
 304              writeln("                    L'ELEMENT ",cherche :2," SE TROUVE DANS L'ARBRE");\r
 305              else\r
 306              writeln("                    L'ELEMENT ",cherche:2," N'EST PAS DANS L'ARBRE");\r
 307            fi;\r
 308            call ligne(11);\r
 309            call continuer;\r
 310 \r
 311       (* APPEL DE LA PROCEDURE INSERANT UN ELEMENT *)\r
 312           when 4 : write(" ENTRER L'ELEMENT A INSERER :");\r
 313            readln(cherche);\r
 314            call inserer (cherche,racine);\r
 315 \r
 316       (* APPEL DE LA PROCEDURE VISUALISANT UN ARBRE *)\r
 317           when 5:\r
 318             if (racine = none)\r
 319               then call ligne(30);\r
 320                    writeln("                         L'ARBRE EST VIDE .");\r
 321                    call ligne(11);\r
 322               else writeln(" L'arbre est : ");\r
 323                    call visualise(racine,1);\r
 324             fi;\r
 325             call continuer;\r
 326 \r
 327        (* SORTIE DU PROGRAMME *)\r
 328           when 6: rep:= false;\r
 329        esac;\r
 330    od;\r
 331 \r
 332 end;\r
 333 end BARBRES.\r
 334 \1a