examples/examples.old/bbarbre2.log

   1 program myBarbres;\r
   2 \r
   3         unit presentation : procedure;\r
   4         begin\r
   5                 pref IIUWgraph block\r
   6                 begin\r
   7                         call gron(1);\r
   8                         call hpage(1,1,1);\r
   9                         call border(5);\r
  10                         call move(270,50);\r
  11                         call color(5);\r
  12                         call outstring("LES ARBRES 2-3");\r
  13                         call move(80,100);\r
  14                         call color(3);\r
  15                         call outstring("MENU :");\r
  16                         call move(100,125);\r
  17                         call color(3);\r
  18                         call outstring("1 -> inserer un element");\r
  19                         call move(100,150);\r
  20                         call outstring("2 -> supprimer un element");\r
  21                         call move(100,175);\r
  22                         call outstring("3 -> existence d'un element");\r
  23                         call move(100,200);\r
  24                         call outstring("4 -> minimum de l'arbre");\r
  25                         call move(100,225);\r
  26                         call outstring("5 -> maximum de l'arbre");\r
  27                         call move(100,250);\r
  28                         call outstring("6 -> vide");\r
  29                         call move(100,275);\r
  30                         call outstring("7 -> afficher l'arbre");\r
  31                         call move(100,300);\r
  32                         call outstring("8 -> fin");\r
  33                         call move(100,325);\r
  34                         call outstring("choix =");\r
  35                 end;\r
  36         end presentation;\r
  37 \r
  38         unit inchar: iiuwgraph function:integer;\r
  39         var i:integer;\r
  40         begin\r
  41                 do\r
  42                         i:=inkey;\r
  43                         if i=/=0 then exit fi;\r
  44                 od;\r
  45                 result:=i;\r
  46         end inchar;\r
  47 \r
  48         unit reponse : IIUWgraph procedure(output r : char);\r
  49         begin\r
  50                 call move(250,325);\r
  51                 call outstring("Tapez o/n pour continuer");\r
  52                 r := chr(inchar);\r
  53                 call hascii(0);\r
  54                 call hascii(ord(r));\r
  55         end reponse;   \r
  56 \r
  57 \r
  58         unit WriteInteger : IIUWgraph procedure( Number : integer );\r
  59         var i, j : integer;\r
  60         begin\r
  61           if Number < 10 then\r
  62                  call HASCII( 0 );\r
  63                  call HASCII( Number + 48 );\r
  64                  call Hascii( 0 );\r
  65           else\r
  66                  i := Number div 10;\r
  67                  j := Number - i * 10;\r
  68                  call HASCII( 0 );\r
  69                  call Hascii( i + 48 );\r
  70                  call Hascii( 0 );\r
  71                  call Hascii( j + 48 );\r
  72           fi;\r
  73         end WriteInteger;\r
  74 \r
  75 \r
  76         (* representation d'un noeud *)\r
  77         unit noeud : class;\r
  78         var pere       : noeud,\r
  79                  nb         : integer,\r
  80                  IG, IM     : integer,\r
  81                  FG, FM, FD : noeud;\r
  82                  (* \r
  83                          pere est le pere\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
  90                  *)\r
  91         begin\r
  92                 (* initialisation des variables *)\r
  93                 pere := none;\r
  94                 nb := 0;\r
  95                 IG := -1;\r
  96                 IM := -1;\r
  97                 FG := none;\r
  98                 FM := none;\r
  99                 FD := none;\r
 100         end noeud;\r
 101 \r
 102 \r
 103 \r
 104         unit barbre : class;\r
 105         var racine : noeud;\r
 106 \r
 107                 unit afficher : procedure(inout courant : noeud);\r
 108                 begin\r
 109                         if courant.IM = -1\r
 110                         then\r
 111                                 (* courant pointe sur une feuille *)\r
 112                                 writeln(courant.IG:1);\r
 113                         else\r
 114                                 (* courant pointe sur un noeud *)\r
 115                                 writeln(courant.IG:1, ":", courant.IM:1);\r
 116                         fi;\r
 117                         \r
 118                         if courant.FG =/= none\r
 119                         then\r
 120                                 (* courant a 1, 2 ou 3 fils *)   \r
 121                                 if courant.FG.FG =/= none\r
 122                                 then\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
 127                                         then\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
 132                                                 then\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
 136                                                 fi;\r
 137                                         fi;\r
 138                                 else\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
 144                                         then\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
 149                                                 then\r
 150                                                         (* courant a 3 fils *)\r
 151                                                         (* affichage de la feuille de droite *)\r
 152                                                         writeln(" ", courant.FD.IG:1);\r
 153                                                 else\r
 154                                                         writeln;\r
 155                                                 fi;\r
 156                                         else\r
 157                                                 writeln;\r
 158                                         fi;\r
 159                                 fi;\r
 160                         fi;\r
 161                 end;\r
 162 \r
 163                 unit reorganiser : procedure(inout courant,bidon : noeud);\r
 164                 begin\r
 165                                         if courant.FG =/= none\r
 166                                         then\r
 167                                                 (* courant a 1, 2 ou 3 fils *)\r
 168                                                 if courant.FG.FG =/= none\r
 169                                                 then\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
 176                                                         then\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
 180                                                         fi;\r
 181 \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
 185                                                         do\r
 186                                                                 case bidon.nb\r
 187                                                                         when 0 : courant.IG := bidon.IG;\r
 188                                                                                                 exit;\r
 189                                                                         when 1 : bidon := bidon.FG;\r
 190 \r
 191                                                                         when 2 : bidon := bidon.FM;\r
 192 \r
 193                                                                         when 3 : bidon := bidon.FD;\r
 194                                                                 esac;\r
 195                                                         od;\r
 196                                                         \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
 200                                                         do\r
 201                                                                 case bidon.nb\r
 202                                                                         when 0 : courant.IM := bidon.IG;\r
 203                                                                                                 exit;\r
 204                                                                         when 1 : bidon := bidon.FG;\r
 205 \r
 206                                                                         when 2 : bidon := bidon.FM;\r
 207 \r
 208                                                                         when 3 : bidon := bidon.FD;\r
 209                                                                 esac;\r
 210                                                         od;\r
 211                                                 else\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
 216                                                         then\r
 217                                                                 (* recuperation de IM pour courant *)\r
 218                                                                 (* courant a 2 ou 3 fils *)\r
 219                                                                 courant.IM := courant.FM.IG;\r
 220                                                         fi;\r
 221                                                 fi;\r
 222                                         fi;\r
 223                                 end reorganiser;\r
 224 \r
 225                 unit vide : function : boolean;\r
 226                 begin\r
 227                         result := (racine.nb = 0);\r
 228                 end vide;\r
 229 \r
 230                 unit minimum : function : integer;\r
 231                 var courant : noeud;\r
 232                 begin\r
 233                         courant := racine;\r
 234                         do\r
 235                                 if courant.FG = none\r
 236                                 then\r
 237                                         (* result contient le plus petit element de l'arbre *)\r
 238                                         result := courant.IG;\r
 239                                         exit;\r
 240                                 else\r
 241                                         (* descendre a gauche *)\r
 242                                         courant := courant.FG;\r
 243                                 fi;\r
 244                         od;\r
 245                 end minimum;\r
 246 \r
 247                 unit maximum : function : integer;\r
 248                 var courant : noeud;\r
 249                 begin\r
 250                         courant := racine;\r
 251                         do\r
 252                                 (* suivant le nombre de fils de courant *)\r
 253                                 case courant.nb\r
 254                                         when 0 : (* result contient le plus grand element de l'arbre *)\r
 255                                                                 result := courant.IG;\r
 256                                                                 exit;\r
 257                                         when 1 : (* le plus grand element se trouve \r
 258                                                                 dans le sous arbre de gauche *)\r
 259                                                                 courant := courant.FG;\r
 260 \r
 261                                         when 2 : (* le plus grand element se trouve\r
 262                                                                 dans le sous arbre du milieu *)\r
 263                                                                 courant := courant.FM;\r
 264 \r
 265                                         when 3 : (* le plus grand element se trouve\r
 266                                                                 dans le sous arbre de droite *)\r
 267                                                                 courant := courant.FD;\r
 268                                 esac;\r
 269                         od;\r
 270                 end maximum;\r
 271          \r
 272                 unit present : function(v : integer; inout courant : noeud) : boolean;\r
 273                 begin\r
 274                         do\r
 275                                 (* suivant le nombre de fils de courant *)\r
 276                                 case courant.nb\r
 277                                         when 0 : (* 0 fils donc c'est une feuille *)\r
 278                                                                 if courant.IG = v\r
 279                                                                 then result := true;\r
 280                                                                 else result := false;\r
 281                                                                 fi;\r
 282                                                                 exit;\r
 283                                         when 1 : (* 1 fils donc le pere est la racine *)\r
 284                                                                 courant := courant.FG;\r
 285                                                                 if courant.IG = v\r
 286                                                                 then result := true;\r
 287                                                                 else result := false;\r
 288                                                                 fi;\r
 289                                                                 exit;\r
 290                                         when 2 : (* 2 fils *)\r
 291                                                                 if courant.IG > v\r
 292                                                                 then\r
 293                                                                         (* v se trouve a gauche, si il existe *) \r
 294                                                                         courant := courant.FG;\r
 295                                                                 else\r
 296                                                                         if courant.IG = v\r
 297                                                                         then\r
 298                                                                                 if courant.nb =/= 0\r
 299                                                                                 then\r
 300                                                                                         courant := courant.FG;\r
 301                                                                                 fi;\r
 302                                                                         else\r
 303                                                                                 (* v ne se trouve pas a gauche, si il existe *)\r
 304                                                                                 if courant.IM > v\r
 305                                                                                 then\r
 306                                                                                         (* v se trouve au milieu, si il existe *)\r
 307                                                                                         courant := courant.FM;\r
 308                                                                                 else\r
 309                                                                                         if courant.IM = v\r
 310                                                                                         then\r
 311                                                                                                 if courant.nb =/= 0\r
 312                                                                                                 then\r
 313                                                                                                         courant := courant.FM;\r
 314                                                                                                 fi;\r
 315                                                                                         else\r
 316                                                                                                 courant := courant.FM;\r
 317                                                                                         fi;\r
 318                                                                                 fi;\r
 319                                                                         fi;\r
 320                                                                 fi;\r
 321                                         when 3 : (* 3 fils *)\r
 322                                                                 if courant.IG > v\r
 323                                                                 then\r
 324                                                                         (* v se trouve a gauche, si il existe *)\r
 325                                                                         courant := courant.FG;\r
 326                                                                 else\r
 327                                                                         if courant.IG = v\r
 328                                                                         then\r
 329                                                                                 if courant.nb =/= 0\r
 330                                                                                 then\r
 331                                                                                         courant := courant.FG;\r
 332                                                                                 fi;\r
 333                                                                         else                            \r
 334                                                                                 (* v ne se trouve pas a gauche, si il existe *)\r
 335                                                                                 if courant.IM > v\r
 336                                                                                 then\r
 337                                                                                         (* v se trouve au milieu, si il existe *)\r
 338                                                                                         courant := courant.FM;\r
 339                                                                                 else\r
 340                                                                                         if courant.IM = v\r
 341                                                                                         then\r
 342                                                                                                 if courant.nb =/= 0\r
 343                                                                                                 then\r
 344                                                                                                         courant := courant.FM;\r
 345                                                                                                 fi;\r
 346                                                                                         else\r
 347                                                                                                 (* v ne se trouve pas a gauche, si il existe *)\r
 348                                                                                                 if courant.IM < v\r
 349                                                                                                 then \r
 350                                                                                                         (* v se trouve a droite, si il existe *)\r
 351                                                                                                         courant := courant.FD;\r
 352                                                                                                 fi;\r
 353                                                                                         fi;\r
 354                                                                                 fi;\r
 355                                                                         fi;\r
 356                                                                 fi;\r
 357                                 esac;\r
 358                         od;\r
 359                 end present;\r
 360 \r
 361 \r
 362 \r
 363 \r
 364 \r
 365                 unit supprimer : IIUWgraph function(v: integer) : barbre;\r
 366                 var courant, p : noeud,\r
 367                          b : barbre;\r
 368                 begin\r
 369                         b := new barbre;\r
 370                         courant := racine;\r
 371                         if present(v, courant)\r
 372                         then\r
 373                                 (* l'element est present dans l'arbre donc on peut le supprimer *)\r
 374                                 p := courant.pere;\r
 375                                 if p.pere = none\r
 376                                 then\r
 377                                         (* p pointe sur la racine *)\r
 378                                         case p.nb\r
 379                                                 when 1 : (* p a 1 fils *)\r
 380                                                                         courant := p;\r
 381                                                                         courant.FG := none;\r
 382                                                                         courant.nb := 0;\r
 383                                                                         courant.IG := -1;\r
 384 \r
 385                                                 when 2 : (* p a 2 fils *)\r
 386                                                                         if p.FG.IG = courant.IG\r
 387                                                                         then\r
 388                                                                                 p.FG := p.FM;\r
 389                                                                                 p.IG := p.FG.IG;\r
 390                                                                         fi;\r
 391                                                                         p.FM := none;\r
 392                                                                         p.nb := p.nb - 1;\r
 393                                                                         p.IM := -1;\r
 394                                                 when 3 : (* p a 3 fils *)\r
 395                                                                         if p.IG = courant.IG\r
 396                                                                         then\r
 397                                                                                 p.FG := p.FM;\r
 398                                                                                 p.FM := p.FD;\r
 399                                                                                 p.IG := p.FG.IG;\r
 400                                                                                 p.IM := p.FM.IG;\r
 401                                                                         else\r
 402                                                                                 if p.FM.IG = courant.IG\r
 403                                                                                 then\r
 404                                                                                         p.FM := p.FD;\r
 405                                                                                         p.IM := p.FM.IG;\r
 406                                                                                 fi;\r
 407                                                                         fi;\r
 408                                                                         p.FD := none;\r
 409                                                                         p.nb := p.nb - 1;\r
 410                                         esac;\r
 411                                 else\r
 412                                         (* p ne pointe pas sur le racine *)\r
 413                                         case p.nb\r
 414                                                 when 2 : (* p a 2 fils *)\r
 415                                                                         pref IIUWgraph block\r
 416                                                                         begin\r
 417                                                                                 call cls;\r
 418                                                                                 call move(10,10);\r
 419                                                                                 call outstring("-> Le cas ou l'on veut supprimer une feuille");\r
 420                                                                                 call move(10,20);\r
 421                                                                                 call outstring("dont le pere a 2 fils n'a pas ete gere.");\r
 422                                                                         end;\r
 423                                                 \r
 424                                                 when 3 : (* p a 3 fils *)\r
 425                                                                         if p.FG.IG = courant.IG\r
 426                                                                         then\r
 427                                                                                 p.FG := p.FM;\r
 428                                                                                 p.FM := p.FD;\r
 429                                                                                 p.IG := p.FG.IG;\r
 430                                                                                 p.IM := p.FM.IG;\r
 431                                                                         else\r
 432                                                                                 if p.FM.IG = courant.IG\r
 433                                                                                 then\r
 434                                                                                         p.FM := p.FD;\r
 435                                                                                         p.IM := p.FM.IG;\r
 436                                                                                 fi;\r
 437                                                                         fi;\r
 438                                                                                 \r
 439                                                                         p.FD := none;\r
 440                                                                         p.nb := p.nb - 1 ;\r
 441                                         esac;\r
 442                                 fi;\r
 443                         else\r
 444                                 pref IIUWgraph block\r
 445                                 begin\r
 446                                         call move(10,20);\r
 447                                         call outstring("-> On ne peut pas supprimer cet element");\r
 448                                         call move(10,30);\r
 449                                         call outstring("car il n'est pas dans l'arbre");\r
 450                                 end;\r
 451                         fi;\r
 452                         b.racine := racine;\r
 453                         result := b;\r
 454                 end supprimer;\r
 455 \r
 456                 unit inserer : function(v : integer) : barbre;\r
 457 \r
 458                         unit refaire : procedure(inout p, f1, f2, j, r : noeud);\r
 459                         begin\r
 460                                 (* suivant le nombre de fils de p *)\r
 461                                 case p.nb\r
 462                                         when 3 : (* p a 3 fils *)\r
 463                                                                 if p.FG = f1\r
 464                                                                 then\r
 465                                                                         p.FD := p.FM;\r
 466                                                                         p.FM := j;\r
 467                                                                 else\r
 468                                                                         p.FD := j;\r
 469                                                                 fi;\r
 470 \r
 471                                         when 4 : (* p a 4 fils *)\r
 472                                                                 (* et creer un nouveau noeud *)\r
 473                                                                 j := new noeud;\r
 474                                                                 if p.FG = f1\r
 475                                                                 then\r
 476                                                                         j.FG := p.FM;\r
 477                                                                         j.FM := p.FD;\r
 478                                                                         p.FM := f2;\r
 479                                                                 else\r
 480                                                                         if p.FM = f1\r
 481                                                                         then\r
 482                                                                                 j.FG := f2;\r
 483                                                                                 j.FM := p.FD;\r
 484                                                                         else\r
 485                                                                                 j.FG := f1;\r
 486                                                                                 j.FM := f2;\r
 487                                                                         fi;\r
 488                                                                 fi;\r
 489                                                                                                 \r
 490                                                                 j.FG.pere := j;\r
 491                                                                 j.FM.pere := j;\r
 492                                                                 j.nb := 2;\r
 493                                                                 p.FD := none;\r
 494                                                                 p.nb := 2;\r
 495                                                                                                 \r
 496                                                                 if p.pere =/= none\r
 497                                                                 then\r
 498                                                                         (* le pere de p n'est pas la racine *)\r
 499                                                                         (* il faut repeter la procedure refaire *)\r
 500                                                                         j.pere := p.pere;\r
 501                                                                         p.pere.nb := p.pere.nb + 1;\r
 502                                                                         call refaire(p.pere, p, j, j, r);\r
 503                                                                 else\r
 504                                                                         (* le pere de p est la racine *)\r
 505                                                                         (* donc il faut creer une nouvelle racine *)\r
 506                                                                         r := new noeud;\r
 507                                                                         r.nb := 2;\r
 508                                                                         r.FG := p;\r
 509                                                                         r.FM := j;\r
 510                                                                         p.pere := r;\r
 511                                                                         j.pere := r;\r
 512                                                                         racine := r;\r
 513                                                                 fi;\r
 514                                 esac;\r
 515                         end refaire;\r
 516 \r
 517 \r
 518                 var bidon, courant, i, f1, f2, j, p, r : noeud,\r
 519                          b : barbre,\r
 520                          pos : integer;\r
 521                 begin\r
 522                         b := new barbre;\r
 523 \r
 524                         bidon := new noeud;\r
 525                         courant := new noeud;\r
 526                         r := new noeud;\r
 527                         i:= new noeud;\r
 528                         f1 := new noeud;\r
 529                         f2 := new noeud;\r
 530                         j := new noeud;\r
 531                         p:= new noeud;\r
 532 \r
 533                         if vide\r
 534                         then\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
 539                                 courant.IG := v;\r
 540                                 racine.IG := v;\r
 541                                 racine.nb := 1;\r
 542                                 racine.FG := courant;\r
 543 \r
 544                                 b.racine := racine;\r
 545                                 result := b;\r
 546 \r
 547                         else\r
 548                                 (* l'arbre n'est pas vide *)\r
 549                                 courant := racine;\r
 550                                 if present(v,courant)\r
 551                                 then\r
 552                                         pref IIUWgraph block\r
 553                                         begin\r
 554                                                 call move(10,20);\r
 555                                                 call outstring("-> L'element ne peut etre inserer");\r
 556                                                 call move(10,30);\r
 557                                                 call outstring("puisqu'il appartient deja a l'arbre.");\r
 558                                         end;                              \r
 559                                 else\r
 560                                         (* l'element n'existe pas dans l'arbre *)\r
 561                                         \r
 562                                         pos := 0;\r
 563 \r
 564                                         i := new noeud;\r
 565                                         p := new noeud;\r
 566                                         i := courant;\r
 567                                         i.pere := courant.pere;\r
 568                                         p := courant.pere;\r
 569 \r
 570                                         (* creer le noeud qui contiendra l'element a inserer *)\r
 571                                         courant := new noeud;\r
 572                                         courant.IG := v;\r
 573                                         courant.pere := p;\r
 574                                         p.nb := p.nb + 1;\r
 575 \r
 576                                         (* determination de la position ou inserer l'element *)\r
 577                                         if i.IG = p.FG.IG\r
 578                                         then\r
 579                                                 pos := 1;\r
 580                                         else\r
 581                                                 if p.FM =/= none\r
 582                                                 then\r
 583                                                         if i.IG = p.FM.IG\r
 584                                                         then\r
 585                                                                 pos := 2;\r
 586                                                         else\r
 587                                                                 if p.FD =/= none\r
 588                                                                 then\r
 589                                                                         if i.IG = p.FD.IG\r
 590                                                                         then\r
 591                                                                                 pos := 3;\r
 592                                                                         fi;\r
 593                                                                 fi;\r
 594                                                         fi;\r
 595                                                 fi;\r
 596                                         fi;\r
 597 \r
 598                                         (* suivant le nombre de fils de p *)\r
 599                                         case p.nb\r
 600                                                 when 2 : (* p a 2 fils *)\r
 601                                                                         if courant.IG > i.IG\r
 602                                                                         then pos := pos + 1;\r
 603                                                                         fi;\r
 604                                                                         \r
 605                                                                         (* suivant la position de l'element *)\r
 606                                                                         case pos\r
 607                                                                                 when 1 : p.FM := p.FG;\r
 608                                                                                                         p.FG := courant;\r
 609                                                                                 when 2 : p.FM := courant;\r
 610                                                                         esac;\r
 611                                                 when 3 : (* p a 3 fils *)\r
 612                                                                         if courant.IG > i.IG\r
 613                                                                         then pos := pos + 1;\r
 614                                                                         fi;\r
 615                                                                         \r
 616                                                                         (* suivant la position de l'element *)\r
 617                                                                         case pos\r
 618                                                                                 when 1 : p.FD := p.FM;\r
 619                                                                                                         p.FM := p.FG;\r
 620                                                                                                         p.FG := courant;\r
 621                                                                                 when 2 : p.FD := p.FM;\r
 622                                                                                                         p.FM := courant;\r
 623                                                                                 when 3 : p.FD := courant;\r
 624                                                                         esac;\r
 625                                                 when 4 : (* p a 4 fils *)\r
 626                                                                         if courant.IG > i.IG\r
 627                                                                         then pos := pos + 1;\r
 628                                                                         fi;\r
 629 \r
 630                                                                         f1 := new noeud;\r
 631                                                                         f2 := new noeud;\r
 632                                                                         \r
 633                                                                         (* suivant la position de l'element *)\r
 634                                                                         case pos\r
 635                                                                                 when 1 : f1 := p.FM;\r
 636                                                                                                         f2 := P.FD;\r
 637                                                                                                         p.FD := none;\r
 638                                                                                                         p.FM := p.FG;\r
 639                                                                                                         p.FG := courant;\r
 640                                                                                                         (**)\r
 641                                                                                 when 2 : f1 := p.FM;\r
 642                                                                                                         f2 := p.FD;\r
 643                                                                                                         p.FD := none;\r
 644                                                                                                         p.FM := courant;\r
 645                                                                                                         (**)\r
 646                                                                                 when 3 : f1 := courant;\r
 647                                                                                                         f2 := p.FD;\r
 648                                                                                                         p.FD := none;\r
 649                                                                                                         (**)\r
 650                                                                                 when 4 : f1 := p.FD;\r
 651                                                                                                         f2 := courant;\r
 652                                                                                                         p.FD := none;\r
 653                                                                                                         (**)\r
 654                                                                         esac;\r
 655 \r
 656                                                                         j := new noeud;\r
 657 \r
 658                                                                         j.FG := f1;\r
 659                                                                         j.FM := f2;\r
 660                                                                         j.FG.pere := j;\r
 661                                                                         j.FM.pere := j;\r
 662                                                                         j.nb := 2;\r
 663                                                                         p.nb := 2;\r
 664 \r
 665                                                                         if p.pere =/= none\r
 666                                                                         then\r
 667                                                                                 (* p a un pere *)\r
 668                                                                                 (* il faut repeter la procedure refaire *)\r
 669                                                                                 j.pere := p.pere;\r
 670                                                                                 p.pere.nb := p.pere.nb + 1;\r
 671                                                                                 call refaire(p.pere, p, j, j, r);\r
 672                                                                         else\r
 673                                                                                 (* p est la racine *)\r
 674                                                                                 (* donc il faut creer une nouvelle racine *)\r
 675                                                                                 r := new noeud;\r
 676                                                                                 r.nb := 2;\r
 677                                                                                 r.FG := p;\r
 678                                                                                 r.FM := j;\r
 679                                                                                 p.pere := r;\r
 680                                                                                 j.pere := r;\r
 681                                                                                 racine := r;\r
 682                                                                         fi;\r
 683                                         esac;\r
 684                                 fi;\r
 685 \r
 686                                 courant := racine;\r
 687                                 b.racine := courant;\r
 688                                 result := b;\r
 689                         fi;\r
 690                 end inserer;\r
 691 \r
 692         begin\r
 693                 racine := new noeud;\r
 694         end barbre;\r
 695 \r
 696 \r
 697 var ba : barbre,\r
 698          touche, e : integer,\r
 699          bidon, courant, a, b : noeud,\r
 700          rep : char,\r
 701          choix : integer;\r
 702 \r
 703 begin\r
 704         ba := new barbre;\r
 705         courant := new noeud;\r
 706         courant := ba.racine;\r
 707         \r
 708         pref IIUWgraph block\r
 709         begin\r
 710                 do\r
 711                         call presentation;\r
 712                         read(choix);\r
 713                         call WriteInteger(choix);\r
 714                         (* selon le choix *)\r
 715                         case choix\r
 716                                 when 1 : (* inserer un element *)\r
 717                                                         rep := 'o';\r
 718                                                         do                     \r
 719                                                                 if rep = 'o'\r
 720                                                                 then\r
 721                                                                         call cls;\r
 722                                                                         call hpage(0,1,1);\r
 723                                                                         call move(10,10);\r
 724                                                                         call outstring("-> Entrez l'element a inserer = ");\r
 725                                                                         read(e);\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
 731                                                                         call reponse(rep);\r
 732                                                                 else if rep ='n'\r
 733                                                                                 then\r
 734                                                                                         exit;\r
 735                                                                                 else\r
 736                                                                                         call reponse(rep);\r
 737                                                                                 fi;\r
 738                                                                 fi;\r
 739                                                         od;\r
 740 \r
 741 \r
 742                                 when 2 : (* supprimer un element *)\r
 743                                                         rep := 'o';\r
 744                                                         do                     \r
 745                                                                 if rep = 'o'\r
 746                                                                 then\r
 747                                                                         call cls;\r
 748                                                                         call hpage(0,1,1);\r
 749                                                                         if ba.vide\r
 750                                                                         then\r
 751                                                                                 call move(10,10);\r
 752                                                                                 call outstring("-> Il est impossible de supprimer un element");\r
 753                                                                                 call move(10,20);\r
 754                                                                                 call outstring("dans un arbre vide");\r
 755                                                                         else\r
 756                                                                                 call move(10,10);\r
 757                                                                                 call outstring("-> Entrez l'element a supprimer = ");\r
 758                                                                                 read(e);\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
 764                                                                                 call reponse(rep);\r
 765                                                                         fi;\r
 766                                                                 else if rep ='n'\r
 767                                                                                 then\r
 768                                                                                         exit;\r
 769                                                                                 else\r
 770                                                                                         call reponse(rep);\r
 771                                                                                 fi;\r
 772                                                                 fi;\r
 773                                                         od;\r
 774 \r
 775                                 when 3 : (* determiner si l'element est present dans l'arbre *)\r
 776                                                         rep := 'o';\r
 777                                                         do                     \r
 778                                                                 if rep = 'o'\r
 779                                                                 then\r
 780                                                                         call cls;\r
 781                                                                         call hpage(0,1,1);\r
 782                                                                         if ba.vide\r
 783                                                                         then\r
 784                                                                                 call move(10,10);\r
 785                                                                                 call outstring("-> Il est impossible de rechercher un element");\r
 786                                                                                 call move(10,20);\r
 787                                                                                 call outstring("dans un arbre vide");\r
 788                                                                         else\r
 789                                                                                 call move(10,10);\r
 790                                                                                 call outstring("Entrez l'element = ");\r
 791                                                                                 read(e);\r
 792                                                                                 call WriteInteger(e);\r
 793                                                                                 courant := ba.racine;\r
 794                                                                                 if ba.present(e,courant)\r
 795                                                                                 then\r
 796                                                                                         call move(10,20);\r
 797                                                                                         call outstring("-> L'element est present");\r
 798                                                                                 else\r
 799                                                                                         call move(10,20);\r
 800                                                                                         call outstring("-> L'element est absent");\r
 801                                                                                 fi;\r
 802                                                                         fi;\r
 803                                                                         call reponse(rep);\r
 804                                                                 else if rep ='n'\r
 805                                                                                 then\r
 806                                                                                         exit;\r
 807                                                                                 else\r
 808                                                                                         call reponse(rep);\r
 809                                                                                 fi;\r
 810                                                                 fi;\r
 811                                                         od;\r
 812 \r
 813 \r
 814                                 when 4 : (* determiner l'element minimum *)\r
 815                                                         call cls;\r
 816                                                         call hpage(0,1,1);\r
 817                                                         if ba.vide\r
 818                                                         then\r
 819                                                                 call move(10,10);\r
 820                                                                 call outstring("-> Il est impossible de rechercher le minimum");\r
 821                                                                 call move(10,20);\r
 822                                                                 call outstring("dans un arbre vide");\r
 823                                                         else\r
 824                                                                 e := ba.minimum;\r
 825                                                                 call move(10,10);\r
 826                                                                 call outstring("-> Le minimum est ");\r
 827                                                                 call WriteInteger(e);\r
 828                                                         fi;\r
 829                                                         call move(250,325);\r
 830                                                         call outstring("Tapez une touche pour continuer");\r
 831                                                         touche := inchar;\r
 832 \r
 833                                 when 5 : (* determiner l'element maximum *)\r
 834                                                         call cls;\r
 835                                                         call hpage(0,1,1);\r
 836                                                         if ba.vide\r
 837                                                         then\r
 838                                                                 call move(10,10);\r
 839                                                                 call outstring("-> Il est impossible de rechercher le maximum");\r
 840                                                                 call move(10,20);\r
 841                                                                 call outstring("dans un arbre vide");\r
 842                                                         else\r
 843                                                                 e := ba.maximum;\r
 844                                                                 call move(10,10);\r
 845                                                                 call outstring("-> Le maximum est ");\r
 846                                                                 call WriteInteger(e);\r
 847                                                         fi;\r
 848                                                         call move(250,325);\r
 849                                                         call outstring("Tapez une touche pour continuer");\r
 850                                                         touche := inchar;\r
 851 \r
 852                                 when 6 : (* determiner si l'arbre est vide *)\r
 853                                                         call cls;\r
 854                                                         call hpage(0,1,1);\r
 855                                                         call move(10,10);\r
 856                                                         if ba.vide then call outstring("-> L'arbre est vide");\r
 857                                                                                   else call outstring("-> L'arbre n'est pas vide");\r
 858                                                         fi;\r
 859                                                         call move(250,325);\r
 860                                                         call outstring("Tapez une touche pour continuer");\r
 861                                                         touche := inchar;\r
 862 \r
 863                                 when 7 : (* affichage de l'arbre *)\r
 864                                                         call cls;\r
 865                                                         if ba.vide\r
 866                                                         then\r
 867                                                                 call hpage(0,1,1);\r
 868                                                                 call move(10,10);\r
 869                                                                 call outstring("L'arbre est vide.");\r
 870                                                         else\r
 871                                                                 courant := ba.racine;\r
 872                                                                 call ba.afficher(courant);\r
 873                                                         fi;\r
 874                                                         call move(250,325);\r
 875                                                         call outstring("Tapez une touche pour continuer");\r
 876                                                         touche := inchar;\r
 877 \r
 878                                 when 8 : (* fin du programme *)\r
 879                                                         call groff;\r
 880                                                         exit;\r
 881                         esac;\r
 882                  od;\r
 883         end;\r
 884 end mybarbre.\r
 885  \r