examples/examples.old/avl.log

   1 Program AVL;\r
   2 (*******************************************************************)\r
   3 (*******************************************************************)\r
   4 (**                                                               **)\r
   5 (**           IMPLEMENTATION DE QUEUE DE PRIORITE                 **)\r
   6 (**             REALISATION AVEC ARBRES A.V.L.                    **)\r
   7 (**                                                               **)\r
   8 (*******************************************************************)\r
   9 (**************       PROJET 1  DE LI1        **********************)\r
  10 (*******************************************************************)\r
  11 (** Annee 1993-1994      REALISE PAR                        UPPA  **)\r
  12 (**           GOUGEON Jean-Yves et RICHARD Jerome                 **)\r
  13 (*******************************************************************)\r
  14 (*******************************************************************)\r
  15  \r
  16  \r
  17 (*************** DEBUT DU PROGRAMME  **********************)\r
  18  \r
  19 (****************** UNIT ************************)\r
  20  \r
  21 (****************************************************************************************************)\r
  22 (**********             LISTE DES UNITs                                                   ***********)\r
  23 (****************************************************************************************************)\r
  24 (********** presentation : page d'acuei                                                   ***********)\r
  25 (********** init_graph   : contient menu et gestion souris                                ***********)\r
  26 (********** aide         : page d'aide du programme                                       ***********)\r
  27 (********** mousepos     : recherche position de souris                                   ***********)\r
  28 (********** message      : regroupement des messages                                      ***********)\r
  29 (********** erreur       : regroupement des messages d'erreurs                            ***********)\r
  30 (********** efface       : efface une partie de l'\82cran concernant les messages           ***********)\r
  31 (********** ecrit        : ecrit le nombre lu au clavier                                  ***********)\r
  32 (********** AVL          : d\82claration de la classe AVL pour initialisation des arbres    ***********)\r
  33 (********** PAUSE        : pour cr\82er une pause \82cran                                     ***********)\r
  34 (********** RG           : rotation gauche                                                ***********)\r
  35 (********** RGD          : rotation gauche droite                                         ***********)\r
  36 (********** INSERT       : insertion dans un arbre                                        ***********)\r
  37 (********** EQUILIBRE    : pour \82quilibrer l'arbre                                        ***********)\r
  38 (********** MEMBER       : pour d\82tecter si l'element est membre de l'arbre               ***********)\r
  39 (********** VIDE         : teste si l'arbre est vide ou non                               ***********)\r
  40 (********** AFFICHE      : affiche l'arbre (racine gauche droit)                          ***********)\r
  41 (********** MAX          : determine l'element maximum de l'arbre                         ***********)\r
  42 (********** MIN          : determine l'element minimum de l'arbre                         ***********)\r
  43 (********** DELETE       : supprime l'element de l'arbre                                  ***********)\r
  44 (****************************************************************************************************)\r
  45  \r
  46 unit presentation:iiuwgraph procedure;\r
  47 begin\r
  48  \r
  49         (* creation d'une bordure*)\r
  50  \r
  51     call border(13);\r
  52  \r
  53         (*creation d'un cadre pour la fenetre*)\r
  54  \r
  55     call move(10,10);\r
  56     call draw(10,340);\r
  57     call draw( 628,340);\r
  58     call draw(628,10);\r
  59     call draw(10,10);\r
  60     call color(2);\r
  61         \r
  62         (*contenu du titre*)\r
  63     call move(160,80);\r
  64     call outstring("IMPLEMENTATION D'UNE QUEUE DE PRIORITE");\r
  65     call move(210,100);\r
  66     call outstring("METHODE DES ARBRES A.V.L.");\r
  67     call color(12);\r
  68     call move(250,180);\r
  69     call outstring("PROJET NUMERO 1");\r
  70     call color(14);\r
  71     call move(130,300);\r
  72     call outstring("PAR : Mr GOUGEON Jean-Yves et Mr RICHARD Jerome");\r
  73         \r
  74         (*appel de la procedure pause pour passer a la suite*)\r
  75     call PAUSE;\r
  76         \r
  77         (*appel de l'effacage de l'ecran*)\r
  78     call cls;\r
  79 end presentation;\r
  80  \r
  81 unit init_graph : iiuwgraph procedure(output chx : integer);\r
  82 var i,b,h,v:integer;\r
  83  \r
  84 begin\r
  85 pref mouse block\r
  86 begin\r
  87         (*teste si le driver de la souris est charge*)\r
  88     if(driver) then\r
  89     \r
  90     call color(10);\r
  91     \r
  92     call  move(0,0);\r
  93     (*creation d'un cadre pour le menu*)\r
  94     call draw(0,26);\r
  95     call draw(639,26);\r
  96     call draw(639,0);\r
  97     call draw(0,0);\r
  98     call move(5,10);\r
  99     \r
 100     (*contenu du menu*)\r
 101     call outstring("   INSERT   SUPPRE   RECHRCH   VIDE   MIN   MAX       QUIT                 ?  ");\r
 102     \r
 103     call move(400,330);\r
 104     call showcursor;\r
 105     (*montre le curseur de la souris*)\r
 106 \r
 107     do\r
 108         call getpress(0,h,v,b,gauche,droit,centre);\r
 109         (*attend un click et detecte le bouton*)\r
 110 \r
 111         if gauche then call mousepos(h,v,chx);\r
 112         (*demande la position de la souris*)\r
 113 \r
 114                 call hidecursor;\r
 115                 (*enleve le curseur et sauve garde l'envirronnement*)\r
 116 \r
 117                 gauche:=false;\r
 118                 (*remet le bouton gauche a false*)\r
 119 \r
 120                 exit;\r
 121         fi;\r
 122     od;\r
 123     else\r
 124         call move(150,200);\r
 125         call outstring("VOUS AVEZ BESOIN DE LA SOURIS");\r
 126 \r
 127         call PAUSE;\r
 128         (*appel de la procedure pause pour passer a la suite*)\r
 129 \r
 130         chx:=7;\r
 131         (*met chx a 7 pour sortir directement*)\r
 132         exit;\r
 133     fi;\r
 134     call color(9);\r
 135     end;\r
 136 end init_graph;\r
 137  \r
 138 unit aide:iiuwgraph procedure;\r
 139 begin\r
 140 call cls;\r
 141 call color(1);\r
 142 call move(180,65);\r
 143 (*creation d'un cadre pour le titre*)\r
 144 call draw(500,65);\r
 145 call draw(500,100);\r
 146 call draw(180,100);\r
 147 call draw(180,65);\r
 148 call color(3);\r
 149 call move(200,80);\r
 150 (*contenu du titre*)\r
 151 call outstring("AIDE SUR L'UTILISATION DU PROGRAMME");\r
 152 call color(4);\r
 153 call move(80,120);\r
 154 (*contenu de l'aide*)\r
 155 call outstring(" INSERT  : Pour construire et inserer des valeurs dans l'arbre.");\r
 156 call move(80,140);\r
 157 call outstring(" SUPPRE  : Pour supprimer un element de l'arbre. ");\r
 158 call move(80,160);\r
 159 call outstring(" RECHRCH : Pour rechercher un element dans l'arbre. ");\r
 160 call move(80,180);\r
 161 call outstring(" VIDE    : Pour indiquer si l'arbre est vide ou non vide.");\r
 162 call move(80,200);\r
 163 call outstring(" MIN     : Pour indiquer le minimum present dans l'arbre.");\r
 164 call move(80,220);\r
 165 call outstring(" MAX     : Pour indiquer le maximum present dans l'arbre.");\r
 166 call move(80,240);\r
 167 call outstring(" QUIT    : Pour sortir de ce programme.");\r
 168 call move(80,260);\r
 169 call outstring(" ?       : Cette page d'aide !");\r
 170 call color(14);\r
 171 call move(80,280);\r
 172 call outstring("Pour selectionner une de ces option il faut placer le cuseur de la");\r
 173 call move(80,300);\r
 174 call outstring("souris sur le choix et cliquer sur le bouton gauche.");\r
 175  \r
 176  \r
 177  \r
 178 end aide;\r
 179  \r
 180 unit mousepos : iiuwgraph procedure (x,y:integer;output chx : integer);\r
 181 var touche:integer;\r
 182 begin\r
 183 (*declaration des emplacements du titre pour retourner le choix correspondant*)\r
 184 if((y>0)and(y<25))then\r
 185         if((x<80)and(x>0)) then chx:=1;\r
 186         else\r
 187         if((x<160)and(x>88)) then chx:=2;\r
 188         else\r
 189         if((x<220)and(x>168)) then chx:=3;\r
 190         else\r
 191         if((x<300)and(x>228)) then chx:=4;\r
 192         else\r
 193         if((x<350)and(x>308)) then chx:=5;\r
 194         else\r
 195         if((x<400)and(x>358)) then chx:=6;\r
 196         else\r
 197         if((x<500)and(x>432)) then chx:=7;\r
 198         else\r
 199         if((x<639)and(x>580)) then chx:=8;\r
 200          fi;  fi;  fi;  fi; fi; fi;  fi; fi;\r
 201 fi;\r
 202  \r
 203 end mousepos;\r
 204  \r
 205 (****** UNIT DE MESSAGE ***********)\r
 206 unit message:iiuwgraph procedure(x:integer);\r
 207 begin\r
 208 case x\r
 209         when 0 :\r
 210 \r
 211         call move(120,330);\r
 212         call outstring("Valider votre choix en cliquant sur le menu ");\r
 213         \r
 214  \r
 215  \r
 216         when 1 :\r
 217 \r
 218         call efface;\r
 219         (*efface les messages*)\r
 220 \r
 221         call move(90,330);\r
 222         call outstring("Entrez la valeur \85 ins\82rer (taper 100 pour stopper la saisie):");\r
 223 \r
 224  \r
 225         when 2 :\r
 226 \r
 227         call efface;\r
 228         (*efface les messages*)\r
 229 \r
 230         call move(150,330);\r
 231         call outstring("Entrer la valeur \85 supprimer:");\r
 232 \r
 233  \r
 234         when 3 :\r
 235 \r
 236         call efface;\r
 237         (*efface les messages*)\r
 238 \r
 239         call move(150,330);\r
 240         call outstring("Entrer la valeur \85 rechercher : ");\r
 241 \r
 242  \r
 243         when 4 :\r
 244 \r
 245         call efface;\r
 246         (*efface les messages*)\r
 247 \r
 248         call move(250,290);\r
 249         call outstring("L'arbre est vide");\r
 250 \r
 251         call PAUSE;\r
 252         (*appel de la procedure pause pour passer a la suite*)\r
 253 \r
 254  \r
 255         when 5 :\r
 256 \r
 257         call efface;\r
 258 \r
 259         call move(150,290);\r
 260         call outstring("L'arbre n'est pas vide");\r
 261 \r
 262         call PAUSE;\r
 263         (*appel de la procedure pause pour passer a la suite*)\r
 264  \r
 265         \r
 266         when 6 :\r
 267 \r
 268           call cls;\r
 269 \r
 270           call move(80,150);\r
 271           call outstring("Au revoir \85 bient\93t pour une future utilisation !!!");\r
 272 \r
 273           call PAUSE;\r
 274           (*appel de la procedure pause pour passer a la suite*)\r
 275  \r
 276         \r
 277         when 7 :\r
 278                     call move(200,40);\r
 279                     call outstring("Voi\87i l'arbre avant r\82\82quilibrage");\r
 280         \r
 281         when 8 :\r
 282                     call move(200,40);\r
 283                     call outstring("Voi\87i l'arbre APRES r\82\82quilibrage");\r
 284         \r
 285         when 9 :\r
 286 \r
 287           call efface;\r
 288           (*efface les messages*)\r
 289 \r
 290           call move(150,290);\r
 291           call outstring("Voi\87i l'\82l\82ment maximun de l'arbre :");\r
 292           call ecrit(tampon,550,290);\r
 293 \r
 294           call PAUSE;\r
 295           (*appel de la procedure pause pour passer a la suite*)\r
 296 \r
 297  \r
 298         when 10 :\r
 299 \r
 300           call efface;\r
 301           (*efface les messages*)\r
 302 \r
 303           call move(150,290);\r
 304           call outstring("Voi\87i l'\82l\82ment minimun de l'arbre :");\r
 305           call ecrit(tampon,500,290);\r
 306 \r
 307           call PAUSE;\r
 308           (*appel de la procedure pause pour passer a la suite*)\r
 309 \r
 310  \r
 311         when 11 :\r
 312 \r
 313           call efface;\r
 314           (*efface les messages*)\r
 315 \r
 316           call move(250,290);\r
 317           call outstring(" n'est pas membre de l'arbre");\r
 318           call ecrit(val,200,290);\r
 319 \r
 320           call PAUSE;\r
 321           (*appel de la procedure pause pour passer a la suite*)\r
 322 \r
 323  \r
 324         when 12 :\r
 325 \r
 326          call efface;\r
 327          (*efface les messages*)\r
 328 \r
 329          call move(150,290);\r
 330          call outstring(" est membre de l'arbre");\r
 331           call ecrit(val,100,290);\r
 332 \r
 333           call PAUSE;\r
 334           (*appel de la procedure pause pour passer a la suite*)\r
 335 \r
 336  \r
 337         when 13 :\r
 338           call efface;\r
 339           (*efface les messages*)\r
 340 \r
 341           call move(250,290);\r
 342           call outstring("L'arbre est vide.");\r
 343 \r
 344           call PAUSE;\r
 345           (*appel de la procedure pause pour passer a la suite*)\r
 346  \r
 347         when 14 :\r
 348            call move(230,40);\r
 349            call outstring(" L'ARBRE A.V.L. ACTUEL");\r
 350            call move(358,60);\r
 351            call outstring("NOEUD");\r
 352            call move(358,80);\r
 353            call outstring("BALANCE");\r
 354  \r
 355 esac;\r
 356 call move(400,330);\r
 357 end message;\r
 358  \r
 359 (********* UNIT ERREUR ********)\r
 360 unit erreur:iiuwgraph procedure(x:integer);\r
 361 begin\r
 362 case x\r
 363  \r
 364         when 1 :\r
 365          call color(10);\r
 366          call efface;\r
 367           (*efface les messages*)\r
 368 \r
 369          call move(100,290);\r
 370          call outstring("L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE SUPPRESSION");\r
 371          call move(400,330);\r
 372  \r
 373         when 2 :\r
 374            call color(10);\r
 375            call efface;\r
 376            (*efface les messages*)\r
 377 \r
 378            call move(100,290);\r
 379            call outstring("L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE RECHERCHE");\r
 380            call move(400,330);\r
 381  \r
 382 esac;\r
 383 end erreur;\r
 384  \r
 385 unit efface:iiuwgraph procedure;\r
 386 var i : integer;\r
 387 begin\r
 388 \r
 389 (*efface l'ecran de y=280 a y=330*)\r
 390 for i:=280 step 5 to 330 do\r
 391     call move(80,i);\r
 392     call outstring("                                                                             ");\r
 393 od;\r
 394 end efface;\r
 395  \r
 396 unit ecrit :iiuwgraph procedure(element : integer, x, y : integer);\r
 397     var length, i : integer;\r
 398   begin\r
 399        call color(5);\r
 400 \r
 401        (*convertion du code ascii en chiffre <1000*)\r
 402        if(element<0) then\r
 403           call move(x-10,y);\r
 404           call outstring("-");\r
 405           element:=(element*(-1));\r
 406        fi;\r
 407        call move(x,y);\r
 408        call Hascii(48 + element div 100);\r
 409        element := element mod 100;\r
 410        call Hascii(48 + element div 10);\r
 411        call Hascii(48 + element mod 10);\r
 412        call move(x-5,y-4);\r
 413             (*creation d'un cadre pour l'element*)\r
 414        call draw(x+28,y-4);\r
 415        call draw(x+28,y+10);\r
 416        call draw(x-5,y+10);\r
 417        call draw(x-5,y-4);\r
 418 end ecrit;\r
 419  \r
 420 unit AVL:class;\r
 421        var balance,info:real,\r
 422        fd,fg:AVL;\r
 423 end AVL;\r
 424  \r
 425 unit PAUSE:iiuwgraph procedure;\r
 426 var touche:char;\r
 427  \r
 428 begin\r
 429 pref mouse block\r
 430 var h,b,v,p:integer,\r
 431 touche:char;\r
 432 begin\r
 433 droit:=false;\r
 434 \r
 435 driver:=init(b);\r
 436 (*teste le driver de souris*)\r
 437 \r
 438 if(driver) then\r
 439     call color(13);\r
 440     call move(150,330);\r
 441     call outstring("Appuyez sur une le bouton droit de la souris...");\r
 442     call move(400,330);\r
 443 \r
 444     (*tantque le bouton droit n'est pas selectionner*)\r
 445     while ( NOT droit) do\r
 446           call getpress(1,h,v,p,gauche,droit,centre);\r
 447     od;\r
 448 \r
 449     (*efface les messages*)\r
 450     call efface;\r
 451 \r
 452     (*restitue la couleur*)\r
 453     call color(9);\r
 454 else\r
 455    call efface;\r
 456    (*efface les messages*)\r
 457 \r
 458    call move(150,330);\r
 459    call outstring("APPUYER SUR UNE TOUCHE....");\r
 460 \r
 461    read(touche);\r
 462 fi;\r
 463 end;\r
 464 end PAUSE;\r
 465  \r
 466 unit RG:procedure(inout sous_arbre:AVL);\r
 467    var aux:AVL;\r
 468 begin\r
 469    aux:=sous_arbre.fd;\r
 470    sous_arbre.fd:=aux.fg;\r
 471    aux.fg:=sous_arbre;\r
 472    sous_arbre:=aux;\r
 473 end RG;\r
 474  \r
 475 unit RD:procedure(inout sous_arbre:AVL);\r
 476    var aux:AVL;\r
 477 begin\r
 478    aux:=sous_arbre.fg;\r
 479    sous_arbre.fg:=aux.fd;\r
 480    aux.fd:=sous_arbre;\r
 481    sous_arbre:=aux;\r
 482 end RD;\r
 483  \r
 484 unit RGD:procedure(inout sous_arbre:AVL);\r
 485 begin\r
 486    call RG(sous_arbre.fg);\r
 487    call RD(sous_arbre);\r
 488 end RGD;\r
 489  \r
 490 unit RDG:procedure(inout sous_arbre:AVL);\r
 491 begin\r
 492    call RD(sous_arbre.fd);\r
 493    call RG(sous_arbre);\r
 494 end RDG;\r
 495  \r
 496 unit INSERT:iiuwgraph procedure(x:integer;inout arbre:AVL);\r
 497    var sous_arbre,\r
 498        ps_arbre,\r
 499        noeud_courant,\r
 500        pn_courant,\r
 501        noeud_cree:AVL;\r
 502 begin\r
 503    (* cr\82ation de l'objet \85 ins\82rer *)\r
 504  \r
 505    noeud_cree:=new AVL;\r
 506    noeud_cree.info:=x;\r
 507    noeud_cree.balance:=0;\r
 508    noeud_cree.fd:=none;\r
 509    noeud_cree.fg:=none;\r
 510  \r
 511    (* si l'arbre est vide *)\r
 512  \r
 513    if arbre=none\r
 514       then\r
 515          arbre:=noeud_cree;\r
 516       else\r
 517  \r
 518          (* recherche de l'emplacement o\97 doit s'effectuer l'insertion *)\r
 519  \r
 520  \r
 521          sous_arbre:=new AVL;\r
 522          ps_arbre:=new AVL;\r
 523          noeud_courant:=new AVL;\r
 524          pn_courant:=new AVL;\r
 525          sous_arbre:=arbre;\r
 526          ps_arbre:=none;\r
 527          noeud_courant:=arbre;\r
 528          pn_courant:=none;\r
 529          while noeud_courant=/=none\r
 530             do\r
 531  \r
 532                (* recherche de l'emplacement et m\82morisation du\r
 533                   dernier sous arbre pour lequel il y aura\r
 534                   eventuellement desequilibre apr\8as insertion\r
 535                   (valeur actuelle de la balance:+1 ou -1)      *)\r
 536  \r
 537                if noeud_courant.balance=/=0\r
 538                   then\r
 539                      sous_arbre:=noeud_courant;\r
 540                      ps_arbre:=pn_courant;\r
 541                fi;\r
 542                pn_courant:=noeud_courant;\r
 543                if x<=noeud_courant.info\r
 544                   then\r
 545                      noeud_courant:=noeud_courant.fg;\r
 546                   else\r
 547                      noeud_courant:=noeud_courant.fd;\r
 548                fi;\r
 549             od;\r
 550  \r
 551             (* ajout du noeud cr\82\82 *)\r
 552  \r
 553             if x<=pn_courant.info\r
 554                then\r
 555                   pn_courant.fg:=noeud_cree;\r
 556                else\r
 557                   pn_courant.fd:=noeud_cree;\r
 558             fi;\r
 559  \r
 560             (* mise \85 jour des d\82s\82quilibres du sous_arbre au\r
 561                noeud cr\82\82 *);\r
 562  \r
 563             noeud_courant:=sous_arbre;\r
 564             while noeud_courant=/=noeud_cree\r
 565                do\r
 566                   if x<=noeud_courant.info\r
 567                      then\r
 568                         noeud_courant.balance:=noeud_courant.balance+1;\r
 569                         noeud_courant:=noeud_courant.fg;\r
 570                      else\r
 571                         noeud_courant.balance:=noeud_courant.balance-1;\r
 572                         noeud_courant:=noeud_courant.fd;\r
 573                   fi;\r
 574             od;\r
 575  \r
 576             (* r\82\82quilibrage *)\r
 577  \r
 578             call cls;\r
 579 \r
 580             call message(7);\r
 581             (*Voi\87i l'arbre avant r\82\82quilibrage*)\r
 582 \r
 583             call AFFICHE(arbre,0,649,60);\r
 584                 (*appel procedure affichage arbre*)  \r
 585 \r
 586             call EQUILIBRE(sous_arbre);\r
 587  \r
 588             if ps_arbre=none\r
 589                then\r
 590                   arbre:=sous_arbre;\r
 591                else\r
 592                   if sous_arbre.info<=ps_arbre.info\r
 593                      then\r
 594                         ps_arbre.fg:=sous_arbre;\r
 595                      else\r
 596                         ps_arbre.fd:=sous_arbre;\r
 597                   fi;\r
 598             fi;\r
 599 \r
 600             call PAUSE;\r
 601             (*appel de la procedure pause pour passer a la suite*)\r
 602 \r
 603             call cls;\r
 604             (*appel de l'effacage de l'ecran*)\r
 605 \r
 606             call color(9);\r
 607 \r
 608             call message(8);\r
 609             (*Voi\87i l'arbre APRES r\82\82quilibrage*)\r
 610 \r
 611             call AFFICHE(arbre,0,649,60);\r
 612             (*appel procedure affichage arbre*) \r
 613 \r
 614             call PAUSE;\r
 615             (*appel de la procedure pause pour passer a la suite*)\r
 616 \r
 617             call color(9);\r
 618    fi;\r
 619 end INSERT;\r
 620  \r
 621 unit EQUILIBRE:procedure(inout sous_arbre:AVL);\r
 622    var\r
 623       aux1,aux2:AVL,\r
 624       balance,\r
 625       balance_fd,\r
 626       balance_fg:real;\r
 627 begin\r
 628 if (NOT VIDE(sous_arbre)) then\r
 629    if sous_arbre.balance=-1\r
 630       then\r
 631  \r
 632          balance:=3;\r
 633       else\r
 634          if sous_arbre.balance=-2\r
 635             then\r
 636                balance:=4;\r
 637             else\r
 638                balance:=sous_arbre.balance;\r
 639          fi;\r
 640    fi;\r
 641    case balance\r
 642       when 0:\r
 643          exit;\r
 644       when 1:\r
 645          exit;\r
 646       when 3:\r
 647          exit;\r
 648       when 2:\r
 649          if sous_arbre.fg.balance=-1\r
 650             then\r
 651                balance_fg:=2;\r
 652             else\r
 653                balance_fg:=sous_arbre.fg.balance;\r
 654          fi;\r
 655          case balance_fg\r
 656             when 0:\r
 657                aux1:=sous_arbre.fg;\r
 658                aux2:=aux1.fd;\r
 659                sous_arbre.balance:=1;\r
 660                aux1.balance:=-1;\r
 661                sous_arbre.fg:=aux2;\r
 662                aux1.fd:=sous_arbre;\r
 663                sous_arbre:=aux1;\r
 664             when 1:\r
 665                call RD(sous_arbre);\r
 666                sous_arbre.balance:=0;\r
 667                sous_arbre.fd.balance:=0;\r
 668             when 2:\r
 669                call RGD(sous_arbre);\r
 670                if sous_arbre.balance=-1\r
 671                   then\r
 672                      balance:=2;\r
 673                   else\r
 674                      if sous_arbre.balance=1\r
 675                         then\r
 676                            balance:=1;\r
 677                         else\r
 678                            balance:=0;\r
 679                      fi;\r
 680                fi;\r
 681                case balance\r
 682                   when 1:\r
 683                      sous_arbre.fg.balance:=0;\r
 684                      sous_arbre.fd.balance:=-1;\r
 685                   when 2:\r
 686                      sous_arbre.fg.balance:=1;\r
 687                      sous_arbre.fd.balance:=0;\r
 688                   when 0:\r
 689                      sous_arbre.fg.balance:=0;\r
 690                      sous_arbre.fd.balance:=0;\r
 691                esac;\r
 692                sous_arbre.balance:=0;\r
 693          esac;\r
 694       when 4:\r
 695          if sous_arbre.fd.balance=-1\r
 696             then\r
 697                balance_fd:=2;\r
 698             else\r
 699                balance_fd:=sous_arbre.fd.balance;\r
 700          fi;\r
 701          case balance_fd\r
 702             when 1:\r
 703                call RDG(sous_arbre);\r
 704                if sous_arbre.balance=-1\r
 705                   then\r
 706                      balance:=2;\r
 707                   else\r
 708                      if sous_arbre.balance = 1\r
 709                         then\r
 710                            balance := 1;\r
 711                         else\r
 712                            balance := 0;\r
 713                      fi;\r
 714                fi;\r
 715                case balance\r
 716                   when 1:\r
 717                      sous_arbre.fd.balance:=-1;\r
 718                      sous_arbre.fg.balance:=0;\r
 719                   when 2:\r
 720                      sous_arbre.fd.balance:=0;\r
 721                      sous_arbre.fg.balance:=1;\r
 722                   when 0:\r
 723                      sous_arbre.fd.balance:=0;\r
 724                      sous_arbre.fg.balance:=0;\r
 725                esac;\r
 726                sous_arbre.balance:=0;\r
 727             when 0:\r
 728                aux1:=sous_arbre.fd;\r
 729                aux1.balance:=1;\r
 730                sous_arbre.balance:=-1;\r
 731                aux2:=aux1.fg;\r
 732                aux1.fg:=sous_arbre;\r
 733                sous_arbre.fd:=aux2;\r
 734                sous_arbre:=aux1;\r
 735             when 2:\r
 736                call RG(sous_arbre);\r
 737                sous_arbre.balance:=0;\r
 738                sous_arbre.fg.balance:=0;\r
 739          esac;\r
 740    esac;\r
 741 fi;\r
 742  \r
 743 end EQUILIBRE;\r
 744  \r
 745 unit MEMBER:function(val:real;\r
 746                      arbre:AVL;\r
 747                      output pos_element:AVL):boolean;\r
 748 begin\r
 749    do\r
 750       if arbre=/=none\r
 751          then\r
 752             pos_element:=arbre;\r
 753             if val>arbre.info\r
 754                then\r
 755                   arbre:=arbre.fd;\r
 756                else\r
 757                   if arbre.info=val\r
 758                      then\r
 759                         result:=TRUE;\r
 760                         exit;\r
 761                      else\r
 762                         arbre:=arbre.fg;\r
 763                   fi;\r
 764             fi;\r
 765          else\r
 766             result:=FALSE;\r
 767             exit;\r
 768       fi;\r
 769    od;\r
 770 end MEMBER;\r
 771  \r
 772 unit VIDE:function(arbre:AVL):boolean;\r
 773 begin\r
 774    if arbre=none\r
 775       then\r
 776          result:=TRUE;\r
 777       else\r
 778          result:=FALSE;\r
 779    fi;\r
 780 end VIDE;\r
 781  \r
 782 unit AFFICHE:iiuwgraph procedure(t:AVL;xmin,xmax,y:integer);\r
 783 var w:integer;\r
 784 begin\r
 785    if t=/=none\r
 786       then\r
 787         w:=((xmin-xmax)/2)+xmax;\r
 788         (*divise la longeur de l'ecran par 2 pour la position*)\r
 789 \r
 790         call color(10);\r
 791         call ecrit(t.info,w,y);\r
 792 \r
 793         call ecrit(t.balance,w,y+20);\r
 794 \r
 795         call AFFICHE(t.fg,xmin,w,y+60);\r
 796         (*appel procedure affichage arbre avec fils gauche*) \r
 797 \r
 798         call AFFICHE(t.fd,w,xmax,y+60);\r
 799         (*appel procedure affichage arbre avec fils droit*) \r
 800    fi;\r
 801    call color(9);\r
 802 end AFFICHE;\r
 803  \r
 804 unit MAX:procedure(input sous_arbre:AVL;output element:AVL);\r
 805 begin\r
 806    element:=sous_arbre;\r
 807    while element.fd=/=none\r
 808       do\r
 809          element:=element.fd;\r
 810    od;\r
 811 end MAX;\r
 812  \r
 813 unit MIN:procedure(input sous_arbre:AVL;output element:AVL);\r
 814 begin\r
 815    element:=sous_arbre;\r
 816    while element.fg=/=none\r
 817       do\r
 818          element:=element.fg;\r
 819    od;\r
 820 end MIN;\r
 821  \r
 822 unit DELETE:procedure(x:real;input arbre:AVL;input pere:AVL);\r
 823 var\r
 824    balance_pere:integer,\r
 825    pere_element,pos_element,element:AVL;\r
 826 begin\r
 827    if x>arbre.info\r
 828       then\r
 829                 (*si x>info de l'arbre aller fils droit*)\r
 830          call DELETE(x,arbre.fd,arbre);\r
 831       else\r
 832          if x<arbre.info\r
 833             then\r
 834                 (*si x<info aller fils gauche*)\r
 835                call DELETE(x,arbre.fg,arbre);\r
 836             else\r
 837  \r
 838                (* on a trouv\82 x *)\r
 839                (* si la balance de l'objet \85 supprimer=0 et si il n'a*)\r
 840                (* pas de fils droit par exemple cela veut dire qu'il n'a*)\r
 841                (*pas de sous_arbre*)\r
 842  \r
 843                if (arbre.balance=0 AND arbre.fd=none)\r
 844                   then\r
 845                      balance_pere:=pere.balance;\r
 846                      if pere.info>x\r
 847                         then\r
 848                            pere.fg:=none;\r
 849                            pere.balance:=pere.balance-1;\r
 850                         else\r
 851                            pere.fd:=none;\r
 852                            pere.balance:=pere.balance+1;\r
 853                      fi;\r
 854                   else\r
 855                      if (arbre.fg=none AND arbre.fd=/=none) OR\r
 856                         (arbre.fg=/=none AND arbre.fd=none)\r
 857                         then\r
 858                            balance_pere:=pere.balance;\r
 859                            if arbre.fd=none\r
 860                               then\r
 861                                  if x<pere.info\r
 862                                     then\r
 863                                        pere.fg:=arbre.fg;\r
 864                                        y:=arbre.fg.info;\r
 865                                        pere.balance:=pere.balance-1;\r
 866                                     else\r
 867                                        pere.fd:=arbre.fg;\r
 868                                        pere.balance:=pere.balance+1;\r
 869                                  fi;\r
 870                               else\r
 871                                  (*le fils gauche est \85 none *)\r
 872                                  if x<pere.info\r
 873                                     then\r
 874                                        pere.fg:=arbre.fd;\r
 875                                        pere.balance:=pere.balance-1;\r
 876                                     else\r
 877                                        pere.fd:=arbre.fd;\r
 878                                        pere.balance:=pere.balance+1;\r
 879                                  fi;\r
 880                            fi;\r
 881                      fi;\r
 882                fi;\r
 883                kill(arbre);\r
 884                 (*destruction de la feuille*)\r
 885                call EQUILIBRE(pere);\r
 886                (* r\82\82quilibrage selon la balance *)\r
 887                                      (* du p\8are *)\r
 888          fi;\r
 889    fi;\r
 890    if low\r
 891       then\r
 892          if x<pere.info\r
 893             then\r
 894                balance_pere:=pere.balance;\r
 895                pere.balance:=pere.balance-1;\r
 896             else\r
 897                balance_pere:=pere.balance;\r
 898                pere.balance:=pere.balance+1;\r
 899          fi;\r
 900       low:=FALSE;\r
 901    fi;\r
 902    if pere.balance=0 AND balance_pere=/=0\r
 903       then\r
 904          low:=TRUE;\r
 905       else\r
 906          low:=FALSE;\r
 907    fi;\r
 908 end DELETE;\r
 909  \r
 910 (**********************FIN UNIT ****************************)\r
 911  \r
 912  \r
 913 (**************************** DEBUT PRINCIPAL *******************)\r
 914 var\r
 915   val,choix,cas,y,valeur,tampon:real,\r
 916   tree,pere_max,elem_max,pere_noeud_supprime,pos_noeud_supprime,pere\r
 917   ,position,recherche:AVL,\r
 918   low,driver,droit,gauche,centre:boolean,\r
 919   nombre_noeud : integer,\r
 920   touche:char;\r
 921  \r
 922  \r
 923 BEGIN\r
 924     pref iiuwgraph block\r
 925     begin\r
 926         driver:=false;\r
 927         call HPAGE(0,0,0);\r
 928         call HPAGE(0,639,349);\r
 929         call gron(0);\r
 930         call presentation;\r
 931         gauche:=false;\r
 932         droit:=false;\r
 933         centre:=false;\r
 934  \r
 935         call border(5);\r
 936         call color(9);\r
 937  \r
 938         (*** demande choix ***)\r
 939         call message(0);\r
 940         (*Valider votre choix en cliquant sur le menu*)\r
 941         \r
 942         call init_graph(choix);\r
 943         \r
 944         nombre_noeud:=0;\r
 945 do\r
 946   case choix\r
 947  \r
 948      when 1:\r
 949 \r
 950         call message(1);\r
 951         (*Entrez la valeur \85 ins\82rer (taper 100 pour stopper la saisie):*)\r
 952 \r
 953         call move(400,330);\r
 954         read(val);\r
 955 \r
 956         while(MEMBER(val,tree,position))do\r
 957 \r
 958          call message(12);\r
 959          (*est membre de l'arbre*)\r
 960 \r
 961          call move(400,330);\r
 962 \r
 963          call message(1);\r
 964          (*Entrez la valeur \85 ins\82rer (taper 100 pour stopper la saisie):*)\r
 965 \r
 966          read(val);\r
 967         od;\r
 968         nombre_noeud:=nombre_noeud+1;\r
 969  \r
 970         while val=/=100\r
 971         do\r
 972         if nombre_noeud<16\r
 973         then\r
 974               call INSERT(val,tree);\r
 975 \r
 976               call message(7);\r
 977               (*Voi\87i l'arbre avant r\82\82quilibrage*)\r
 978 \r
 979               call message(1);\r
 980               (*Entrez la valeur \85 ins\82rer (taper 100 pour stopper la saisie):*)\r
 981 \r
 982               call move(400,330);\r
 983 \r
 984               read(val);\r
 985 \r
 986               while(MEMBER(val,tree,position))do\r
 987 \r
 988                     call message(12);\r
 989                     (*est membre de l'arbre*)\r
 990 \r
 991                     call move(400,330);\r
 992 \r
 993                     call message(1);\r
 994                     (*Entrez la valeur \85 ins\82rer (taper 100 pour stopper la saisie):*)\r
 995 \r
 996                     read(val);\r
 997               od;\r
 998               nombre_noeud:=nombre_noeud+1;\r
 999         else\r
1000            call color(10);\r
1001            call move(150,290);\r
1002            call outstring(" VOUS AVEZ ATTEINT LE MAXIMUM ");\r
1003 \r
1004            call PAUSE;\r
1005            (*appel de la procedure pause pour passer a la suite*)\r
1006 \r
1007            val:=100;\r
1008            (*affecte 100 pour sortir de la boucle*)\r
1009 \r
1010            call color(9);\r
1011         fi;\r
1012         od;\r
1013         call efface;\r
1014  \r
1015      when 2:\r
1016  \r
1017         if VIDE(tree)\r
1018         then\r
1019 \r
1020          call erreur(1);\r
1021          (*L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE SUPPRESSION*)\r
1022 \r
1023          call PAUSE;\r
1024          (*appel de la procedure pause pour passer a la suite*)\r
1025 \r
1026         else\r
1027  \r
1028          call message(2);\r
1029          (*Entrer la valeur \85 supprimer:*)\r
1030 \r
1031          call move(400,330);\r
1032          read(val);\r
1033          (*lit nouvelle valeur*)\r
1034  \r
1035          if member(val,tree,position)\r
1036            then\r
1037 \r
1038               call message(7);\r
1039               (*Voi\87i l'arbre avant r\82\82quilibrage*)\r
1040               pere:=new AVL;\r
1041 \r
1042               if position.fg=/=none AND position.fd=/=none\r
1043                  then\r
1044 \r
1045                     call MAX(position.fg,elem_max);\r
1046                     valeur:=elem_max.info;\r
1047                     call DELETE(elem_max.info,tree,pere);\r
1048                     if MEMBER(val,tree,position)\r
1049                        then\r
1050                           position.info:=valeur;\r
1051                     fi;\r
1052 \r
1053                     if VIDE(tree)\r
1054                     then\r
1055 \r
1056                      call message(13);\r
1057                      (*L'arbre est vide.*)\r
1058 \r
1059                     else\r
1060 \r
1061                      call cls;\r
1062                      (*appel de l'effacage de l'ecran*)\r
1063 \r
1064                      call message(7);\r
1065                      (*Voi\87i l'arbre avant r\82\82quilibrage*)\r
1066 \r
1067                      call AFFICHE(tree,0,649,60);\r
1068                      (*appel procedure affichage arbre*)\r
1069 \r
1070                      call EQUILIBRE(tree);\r
1071 \r
1072                      call PAUSE;\r
1073                       (*appel de la procedure pause pour passer a la suite*)\r
1074 \r
1075                      call cls;\r
1076                       (*appel de l'effacage de l'ecran*)\r
1077 \r
1078                      call message(8);\r
1079                      (*Voi\87i l'arbre APRES r\82\82quilibrage*)\r
1080 \r
1081                      call AFFICHE(tree,0,649,60);\r
1082                      (*appel procedure affichage arbre*)\r
1083 \r
1084                      call PAUSE;\r
1085                      (*appel de la procedure pause pour passer a la suite*)\r
1086                      call color(9);\r
1087                   fi;\r
1088                  else\r
1089                     call DELETE(val,tree,pere);\r
1090 \r
1091                     call cls;\r
1092                     (*appel de l'effacage de l'ecran*)\r
1093 \r
1094                     call message(7);\r
1095                     (*Voi\87i l'arbre avant r\82\82quilibrage*)\r
1096 \r
1097                     call AFFICHE(tree,0,649,60);\r
1098                     (*appel procedure affichage arbre*)\r
1099                     call EQUILIBRE(tree);\r
1100                     call PAUSE;\r
1101                     (*appel de la procedure pause pour passer a la suite*)\r
1102 \r
1103                     call cls;\r
1104                     (*appel de l'effacage de l'ecran*)\r
1105 \r
1106                     call message(8);\r
1107                     (*Voi\87i l'arbre APRES r\82\82quilibrage*)\r
1108 \r
1109                     call AFFICHE(tree,0,649,60);\r
1110                     (*appel procedure affichage arbre*)\r
1111 \r
1112                     call PAUSE;\r
1113                     (*appel de la procedure pause pour passer a la suite*)\r
1114 \r
1115                     call color(9);\r
1116               fi;\r
1117               if(VIDE(tree)) then\r
1118                  nombre_noeud:=0;\r
1119               else\r
1120                  nombre_noeud:=nombre_noeud-1;\r
1121               fi;\r
1122         else\r
1123  \r
1124               call message(11);\r
1125  \r
1126          fi;\r
1127         fi;\r
1128  \r
1129      when 3:\r
1130         if VIDE(tree)\r
1131         then\r
1132            call erreur(2);\r
1133            (*L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE RECHERCHE*)\r
1134            call PAUSE;\r
1135             (*appel de la procedure pause pour passer a la suite*)\r
1136         else\r
1137                 call message(3);\r
1138                   (*Entrer la valeur \85 rechercher :*)\r
1139                 call move(400,330);\r
1140                 read(val);\r
1141                 if (MEMBER(val,tree,position))\r
1142                 then\r
1143                    call message(12);\r
1144                     (*est membre de l'arbre*)\r
1145                 else\r
1146                    call message(11);\r
1147                    (*n'est pas membre de l'arbre*)\r
1148                 fi;\r
1149         fi;\r
1150  \r
1151      when 4:\r
1152  \r
1153         if VIDE(tree)\r
1154            then\r
1155                 call message(4);\r
1156                  (*L'arbre est vide*)\r
1157            else\r
1158                 call message(5);\r
1159                 (*L'arbre n'est pas vide*)\r
1160         fi;\r
1161  \r
1162      when 5:\r
1163  \r
1164         if VIDE(tree)\r
1165         then\r
1166                 call erreur(2);\r
1167                 (*L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE RECHERCHE*)\r
1168                 call PAUSE;\r
1169                 (*appel de la procedure pause pour passer a la suite*)\r
1170         else\r
1171            recherche:=tree;\r
1172            while(recherche=/=none)\r
1173            do\r
1174               tampon:=recherche.info;\r
1175               recherche:=recherche.fg;\r
1176            od;\r
1177            call message(10);\r
1178            (*Voi\87i l'\82l\82ment minimun de l'arbre :*)\r
1179         fi;\r
1180  \r
1181      when 6:\r
1182  \r
1183         if VIDE(tree)\r
1184         then\r
1185                 call erreur(2);\r
1186                 (*L'arbre est vide : IMPOSSIBLE D'EFFECTUER UNE RECHERCHE*)\r
1187                 call PAUSE;\r
1188                 (*appel de la procedure pause pour passer a la suite*)\r
1189         else\r
1190           recherche:=tree;\r
1191           while(recherche=/=none)\r
1192           do\r
1193               tampon:=recherche.info;\r
1194               recherche:=recherche.fd;\r
1195           od;\r
1196           call message(9);\r
1197           (*Voi\87i l'\82l\82ment maximun de l'arbre :*)\r
1198         fi;\r
1199  \r
1200      when 7:\r
1201                 call message(6);\r
1202                 (*Au revoir \85 bient\93t pour une future utilisation !!*)\r
1203                 exit;\r
1204      when 8 : (* AIDE *)\r
1205                 call efface;\r
1206                 (*efface les messages*)\r
1207                 call aide;\r
1208                 (*appel procedure aide*)\r
1209                 call PAUSE;\r
1210                 (*appel de la procedure pause pour passer a la suite*)\r
1211   esac;\r
1212         call cls;\r
1213           (*appel de l'effacage de l'ecran*)\r
1214         call message(14);\r
1215          (*L'ARBRE A.V.L. ACTUEL*)\r
1216         call AFFICHE(tree,0,649,60);\r
1217         (*appel procedure affichage arbre*)\r
1218         call color(9);\r
1219         call message(0);\r
1220         (*Valider votre choix en cliquant sur le menu*)\r
1221         call init_graph(choix);\r
1222   od;\r
1223         call groff;\r
1224     end;\r
1225 END AVL;\r
1226 (*************************FIN PRINCIPAL ********************)\r