examples/data_str/2_3arb.log

   1 PRogram Projet2;\r
   2 \r
   3 \r
   4 (****    GESTION DES CARACTERES SAISIES POUR L'AFFICHAGE EN MODE GRAPHIQUE   ***)\r
   5 \r
   6 UNIT inchar : IIUWgraph function(a:integer): integer;\r
   7     \r
   8     var i : integer;\r
   9   begin\r
  10     call move(100,315);\r
  11     call color(grisfonce);\r
  12     case a\r
  13     when 1:\r
  14     call outstring("            <ESC>: menu principal");\r
  15     when 2:\r
  16     call outstring("<RC>: nouvelle saisie     <ESC>: menu principal");\r
  17     esac;\r
  18     do\r
  19 \r
  20       i := inkey;\r
  21       if a=1 then\r
  22          if i=27 then exit;\r
  23          fi;\r
  24       else\r
  25         if i=27 or i=13 then exit fi;\r
  26       fi;\r
  27     od;\r
  28     call move(100,315);\r
  29     call outstring("                                                      ");\r
  30     result := i;\r
  31 end inchar;\r
  32 \r
  33 UNIT SAISIE:IIUWGRAPH function(e,x,y:integer):arrayof char;\r
  34 var i,n:integer,\r
  35     c: integer,\r
  36     t :arrayof char;\r
  37 begin\r
  38  \r
  39   array t dim(1:e);\r
  40   for i:=1 to e do\r
  41   t(i):='a';\r
  42   od;\r
  43   call color(grisclair);\r
  44   do\r
  45   i:=1;\r
  46   c:=inkey;\r
  47   while c<>13 and c<>27 and i<=e do\r
  48    if c-48>=0 and c-48<=9 then\r
  49    t(i):=chr(c);\r
  50    call move(x+i*9,y);\r
  51    call hascii(c);\r
  52   \r
  53    i:=i+1;\r
  54    fi;\r
  55    c:=inkey;\r
  56   od;\r
  57   if t(1)<>'a' then exit; fi;\r
  58   od;\r
  59   result:=t;\r
  60 end SAISIE;\r
  61 \r
  62 UNIT ConvEnt:function(t:arrayof char):integer;\r
  63 var n,i:integer;\r
  64 begin\r
  65   n:=0;\r
  66   for i:=1 to upper(t) do\r
  67    if t(i)<>'a' then\r
  68      n:=n*10+(ord(t(i))-48);\r
  69    fi;\r
  70   od;\r
  71    write(n);\r
  72    result:=n;\r
  73 end ConvEnt;\r
  74 \r
  75 UNIT ConvASC:function(i:integer):arrayof char;\r
  76  var t: arrayof char,\r
  77      n,r:integer;\r
  78 begin\r
  79   array t dim(1:10);\r
  80   n:=1;\r
  81   if i=0 then \r
  82      t(1):=chr(48);\r
  83      n:=n+1;\r
  84   else\r
  85  \r
  86   while I<>0 do\r
  87    t(n):=chr((i mod 10) +48);\r
  88    i:=i div 10;\r
  89    n:=n+1;\r
  90    \r
  91   od;\r
  92 \r
  93   fi;\r
  94   array result dim(1:(n-1));\r
  95   for r:=1 to (n-1) do\r
  96   result(r):=t(((n-1)-r)+1);\r
  97   od;\r
  98   kill(t);\r
  99 END convasc;\r
 100 \r
 101 UNIT drawmenu: IIUWGRAPH procedure;\r
 102 begin\r
 103 call color(grisclair);\r
 104 call move(0,200);\r
 105 call draw(620,200);\r
 106 call move(620,202);\r
 107 call draw(0,202);\r
 108 call move(240,208);\r
 109 call color(bleu);\r
 110 call outstring("GESTION DES ARBRES 23");\r
 111 call color(grisclair);\r
 112 call move(0,220);\r
 113 call draw(620,220);\r
 114 call move(5,230);\r
 115 call outstring(" 1-inserer des elements      3-element minimum       5-detruire un arbre");\r
 116 call move(5,240);\r
 117 call outstring(" 2-supprimer un element      4-element de l'arbre    6-afficher une fouffe");\r
 118 call move(5,250);\r
 119 call outstring("                             0-quitter le programme");\r
 120 \r
 121 call move(0,260);\r
 122 call draw(620,260);\r
 123 call move(0,277);\r
 124 call draw(620,277);\r
 125 call move(620,200);\r
 126 call draw(620,330);\r
 127 call draw(0,330);\r
 128 call draw(0,200);\r
 129 END drawmenu;\r
 130 \r
 131  UNIT SelectMenu: IIUWGRAPH function:integer;\r
 132   var choix:integer;\r
 133   begin\r
 134     call color(rouge);\r
 135     call move(1,265);\r
 136     call outstring("                                                                          ");\r
 137     call move(5,265);\r
 138     call outstring("Votre choix :");\r
 139     \r
 140     do\r
 141      choix:=convent(saisie(1,110,265));\r
 142      if choix>=0 and choix<=6 then exit;fi;\r
 143     od;\r
 144     call move(1,265);\r
 145     call outstring("                                                                          ");\r
 146     call move(1,290);\r
 147     call outstring("                                                                          ");\r
 148     call move(1,310);\r
 149     call outstring("                                                                          ");\r
 150     result:=choix;\r
 151    end;\r
 152 (*** FIN DE LA GESTION DE L'AFFICHAGE...  ***)\r
 153 \r
 154 \r
 155     \r
 156 (****  DECLARATION DU TYPE: OBJET...   *****)\r
 157 UNIT CObjet: CLASS;\r
 158     UNIT objet:IIUWGRAPH class;\r
 159       unit virtual show: procedure(x,y:integer);\r
 160       end show;\r
 161       unit virtual getvalue:function:integer;\r
 162        end getvalue;\r
 163        unit virtual length:function:integer;\r
 164        end length;\r
 165     end objet;\r
 166 \r
 167     UNIT elem:objet class(val:integer);\r
 168        unit virtual getvalue: function:integer;\r
 169          begin\r
 170              \r
 171             result:=val;\r
 172          end;\r
 173        unit virtual length:function:integer;\r
 174        var t:arrayof char;\r
 175        begin\r
 176           t:=convASC(val);\r
 177           result:=upper(t);\r
 178        end;\r
 179 \r
 180        unit virtual show: procedure(x,y:integer);\r
 181         var a,f,i:integer,\r
 182             c:char,\r
 183             tab:arrayof char;\r
 184         begin\r
 185          tab:=convasc(val);\r
 186          f:=(longueur*8-(upper(tab)*8+(upper(tab)-1)*2))div 2;\r
 187          f:=f+x;\r
 188          for i:=1 to upper(tab) do\r
 189            call move(f,y);\r
 190            c:=tab(i);\r
 191            call hascii(ord(c));\r
 192            f:=f+10;\r
 193          od;\r
 194            kill(tab);\r
 195         end show;\r
 196        \r
 197      end elem;\r
 198 \r
 199 END Cobjet;\r
 200 (****  fin de la declaration de OBJET  ****)    \r
 201 \r
 202 \r
 203 \r
 204 \r
 205 \r
 206 \r
 207 \r
 208 \r
 209 UNIT arbre23: CObjet class;\r
 210 \r
 211 VAR  racine:arbre,aux:arbre,eq:boolean;             \r
 212     \r
 213 (****  STRUCTURE DE L'ARBRE 23    ****)\r
 214 \r
 215 (****  hierarchie:   arbre -|-- noeud                  *******)\r
 216 (**                         |-- feuille                      *)\r
 217 \r
 218 \r
 219 \r
 220     UNIT Arbre: IIUWGRAPH class;         (** ABSTRACT CLASS **)\r
 221       unit virtual display: procedure(inout h,l:integer);\r
 222       end display;\r
 223       unit virtual getinfo:function(quoi:integer):objet;\r
 224       end getinfo;\r
 225     END arbre;\r
 226     \r
 227     UNIT Noeud: Arbre CLASS (inf,sup:objet);\r
 228 \r
 229        VAR arbG,arbM,arbD:arbre;\r
 230        \r
 231        unit virtual getinfo:function(quoi:integer):objet;\r
 232         begin\r
 233          case quoi\r
 234            when 1:result:=inf;\r
 235            when 2:result:=sup;\r
 236          esac;\r
 237         end getinfo;\r
 238 \r
 239        unit enfants:function:integer;\r
 240        var i:integer;\r
 241        begin\r
 242           i:=0;\r
 243           if arbG<>none then i:=i+1; fi;\r
 244           if arbM<>none then i:=i+1; fi;\r
 245           if arbD<>none then i:=i+1; fi;\r
 246           result:=i;\r
 247        end;\r
 248        UNIT integre:function:boolean;\r
 249        begin\r
 250          result:= (arbD=none);\r
 251        end integre;\r
 252        \r
 253        UNIT virtual display: procedure(inout h,l:integer);\r
 254        var x1,x2:integer;\r
 255        begin \r
 256         x1:=h - (((8*longueur+(longueur-1)*2)*2+4) div 2);\r
 257         x2:=h - (((8*longueur+(longueur-1)*2)*2+4)div 2);;\r
 258 \r
 259         call color(grisclair);\r
 260         call inf.show(x2,l);\r
 261         x2:=x1+(8*longueur+(longueur-1)*2);\r
 262         call color(grisfonce);\r
 263         call move(x2,l-5);\r
 264         call draw(x2,l+10);\r
 265         call move(x2,l);\r
 266         \r
 267         x2:=x2+2;\r
 268         call color(grisclair);\r
 269         call sup.show(x2,l);\r
 270          call color(grisfonce);\r
 271          call move(x2,l);\r
 272 \r
 273         x2:=x2+(8*longueur+(longueur-1)*2);\r
 274         call move(x1-2,l-5);\r
 275         call draw(x2+2,l-5);\r
 276         call draw(x2+2,l+10);\r
 277         call draw(x1-2,l+10);\r
 278         call draw(x1-2,l-5);        \r
 279        end display;\r
 280 \r
 281     END noeud;\r
 282 \r
 283 \r
 284     UNIT Feuille: arbre CLASS(e:objet);\r
 285          \r
 286          unit virtual display:  procedure(inout h,l:integer);\r
 287            VAR X1,X2:integer;\r
 288            begin\r
 289             x1:=h - ((8*longueur+(longueur-1)*2+4) div 2);\r
 290             call color(rouge);\r
 291             call e.show(x1,l);\r
 292             call color(grisfonce);\r
 293             x2:=x1+(8*longueur+(longueur-1)*2);\r
 294             call move(x1-2,l-5);\r
 295             call draw(x2+2,l-5);\r
 296             call draw(x2+2,l+10);\r
 297             call draw(x1-2,l+10);\r
 298             call draw(x1-2,l-5);\r
 299            end DISPLAY;\r
 300          unit virtual getinfo:function(quoi:integer):objet;\r
 301           begin\r
 302            result:=e;\r
 303           end getinfo;\r
 304     END feuille;\r
 305 \r
 306 \r
 307 \r
 308        UNIT SousArbre: function(a:arbre;element:objet):arbre; \r
 309        var linf,lesup:objet;\r
 310        begin\r
 311         linf:=a.getinfo(inf);\r
 312         lesup:=a.getinfo(sup);\r
 313         if element.getvalue<=linf.getvalue then \r
 314                    result:=a qua noeud.arbG;\r
 315         else \r
 316            if lesup.getvalue=-1 then\r
 317                result:=a qua noeud.arbG;\r
 318 \r
 319            else\r
 320            if element.getvalue<=lesup.getvalue then \r
 321                    result:=a qua noeud.arbM;\r
 322                \r
 323            else \r
 324                   if a qua noeud.arbD=none then \r
 325                    result:=a qua noeud.arbM;\r
 326                   else \r
 327                     result:=a qua noeud.arbD;\r
 328                   fi;\r
 329            fi;\r
 330            fi;\r
 331         fi;\r
 332      \r
 333        END sousarbre;\r
 334     \r
 335 \r
 336 UNIT affichage:IIUWGRAPH procedure(r:arbre);\r
 337 var x,y,t,i:integer;\r
 338 begin\r
 339     call drawmenu;\r
 340     x:=5;\r
 341 \r
 342     y:=25;\r
 343     i:=0;\r
 344     call afficheArbre23(r,y,x,i);\r
 345     call move(70,290);\r
 346     call color(rouge);\r
 347     call outstring("les elements de l'arbre sont des nombres inferieurs a 100");\r
 348     call move(110,310);\r
 349     call outstring(" !!! JUSQU'A 24 ELEMENTS PEUVENT ETRE AFFICHES !!!");\r
 350 end;\r
 351 Unit affichearbre23: IIUWGRAPH procedure\r
 352          (r:arbre;inout y:integer;x:integer;inout i:integer);\r
 353  const esp=5;\r
 354  var yD,yG,a,\r
 355      t1,t2,t3:integer;\r
 356 \r
 357  begin\r
 358     if r<> none then\r
 359        if r is feuille then call r.display(y,x);\r
 360        else\r
 361           \r
 362           if r qua noeud.arbG is feuille then\r
 363             if r qua noeud.enfants=2 then \r
 364                yD:=y;\r
 365               \r
 366                t1:=y;\r
 367                call affichearbre23(r qua noeud.arbG,y,x+40,i);\r
 368                \r
 369                y:=y+22+esp;                \r
 370                t2:=y;\r
 371                t3:=0;\r
 372                call affichearbre23(r qua noeud.arbM,y,x+40,i);\r
 373                y:=y+22+esp;\r
 374                yD:=yD+(51 div 2);\r
 375                i:=yD;\r
 376                call r.display(yD,x);  \r
 377                  call color(grisfonce);\r
 378                  call move(t1,(x+40)-5);\r
 379                  call draw(yD,x+10);\r
 380                  call move(t2,(x+40)-5);\r
 381                  call draw(yD,x+10);\r
 382            \r
 383              else  \r
 384                yd:=y;\r
 385               \r
 386                t1:=y;\r
 387                call affichearbre23(r qua noeud.arbG,y,x+40,i);\r
 388                y:=y+22+esp;\r
 389                t2:=y;\r
 390                call affichearbre23(r qua noeud.arbM,y,x+40,i);\r
 391                y:=y+22+esp;\r
 392                t3:=y;\r
 393                call affichearbre23(r qua noeud.arbD,y,x+40,i);\r
 394                y:=y+22+esp;\r
 395                yD:=yD+(60 div 2);\r
 396                i:=yd;\r
 397                call color(grisfonce);\r
 398                call move(t1,(x+40)-5);\r
 399                  call draw(yD,x+8);\r
 400                call move(t2,(x+40)-5);\r
 401                  call draw(yD,x+8);\r
 402                call move(t3,(x+40)-5);\r
 403                  call draw(yD,x+8);\r
 404 \r
 405            \r
 406                call r.display(yd,x);  \r
 407              fi;    \r
 408              \r
 409          else\r
 410            \r
 411            call affichearbre23(r qua noeud.arbG,y,x+40,i);\r
 412            t1:=i;\r
 413            call affichearbre23(r qua noeud.arbM,y,x+40,i);\r
 414            t2:=i;\r
 415            call affichearbre23(r qua noeud.arbD,y,x+40,i);             \r
 416            t3:=i;\r
 417              call color(grisfonce);\r
 418              if r qua noeud.enfants=2 then \r
 419                  yd:=t1+((t2-t1)/2);\r
 420                  call move(t1,x+35); \r
 421                  call draw(yd,x+8);\r
 422                  call move(t2,x+35);\r
 423                  call draw(yd,x+8);\r
 424              else    \r
 425                  yd:=t1+((t3-t1)/2);\r
 426                  call move(t1,x+35); \r
 427 \r
 428                  call draw(yd,x+8);\r
 429                  call move(t2,x+35);\r
 430                  call draw(yd,x+8);\r
 431                  call move(t3,x+35);\r
 432                  call draw(yd,x+8);\r
 433              fi;\r
 434            \r
 435            \r
 436            call r.display(yd,x);                 \r
 437            i:=yd;\r
 438 \r
 439            fi;\r
 440      fi;\r
 441 fi;\r
 442  \r
 443  \r
 444 end affichearbre23;\r
 445 \r
 446 \r
 447 \r
 448 unit suppression:function(d:arbre,num:objet):boolean;\r
 449 var delete:boolean,cousin:arbre;\r
 450      \r
 451 begin\r
 452     (****   INITIALISATION ****)\r
 453         if d<>none then\r
 454         delete:=false;\r
 455         cousin:=none;\r
 456         if member(d,num) then\r
 457         call supprime(d,num,delete,cousin);\r
 458         result:=true;\r
 459         else  result:=false;\r
 460         fi;\r
 461         else result:=false;\r
 462         fi;\r
 463 end;\r
 464 UNIT supprime: procedure(p:arbre,n:objet;inout deleted:boolean,aux:arbre);\r
 465 var linf,lesup:objet,\r
 466     fils:arbre;\r
 467 begin\r
 468       linf:=p.getinfo(1);\r
 469       lesup:=p.getinfo(2);\r
 470   \r
 471       if p is feuille then  (**   le pere est une feuille **)\r
 472          kill(p);\r
 473          racine:=none;\r
 474          deleted:=true;\r
 475       else\r
 476          fils:=sousarbre(p,n);\r
 477          \r
 478          if fils is feuille then (* fils est une feuille **)\r
 479             deleted:=true;  (* on le supprime*)\r
 480             if p qua noeud.enfants=2 then   (* l'arbre n'est plus un arbre 23 *)\r
 481               if n.getvalue=linf.getvalue then\r
 482                 aux:=p qua noeud.arbM;\r
 483               else aux:=p qua noeud.arbG;\r
 484               fi;\r
 485               kill(fils);      \r
 486               if p=racine then\r
 487               racine:=aux;\r
 488               fi;\r
 489               kill(p);     \r
 490                (* on supprime le noeud car il a qu'un fils...*)\r
 491             else\r
 492                kill(fils);\r
 493                call decale(p);\r
 494                aux:=none;\r
 495             fi;\r
 496          ELSE   (* fils est un noeud..*)\r
 497       \r
 498             call supprime(fils,n,deleted,aux);\r
 499             if deleted then\r
 500                 if aux<>none then\r
 501                    if p qua noeud.enfants=1 then\r
 502                        if p qua noeud.arbg=none then\r
 503                            p qua noeud.arbG:=p qua noeud.arbM;\r
 504                            p qua noeud.arbM:=none;\r
 505                            p qua noeud.inf:=supI(p qua noeud.arbG);\r
 506                            p qua noeud.sup:=new elem(-1);\r
 507                        else p qua noeud.sup:=new elem(-1);\r
 508                        fi;\r
 509                    else call decale(p);\r
 510                    fi;\r
 511                    fils:=sousarbre(p,aux.getinfo(inf));\r
 512                    if fils qua noeud.enfants=3 then\r
 513                        aux:=ordre(aux.getinfo(inf),fils,aux);\r
 514                        call ordonne(aux.getinfo(inf),p,aux);\r
 515                        aux:=none;\r
 516                     else \r
 517                         call ordonne(aux.getinfo(inf),fils,aux);\r
 518                         p qua noeud.inf:=supI(p qua noeud.arbG);\r
 519                         p qua noeud.sup:=supI(p qua noeud.arbM);\r
 520                         \r
 521                         aux:=none;\r
 522                     fi;\r
 523       \r
 524                    if p qua noeud.enfants=1 then \r
 525                        if p=racine then\r
 526                           racine:=fils;\r
 527                        else\r
 528                           aux:=fils;\r
 529                        fi;\r
 530                        kill(p);      \r
 531                    fi;\r
 532                 else\r
 533                    p qua noeud.inf:=supI(p qua noeud.arbG);\r
 534                    p qua noeud.sup:=supI(p qua noeud.arbM);\r
 535                 fi;\r
 536             fi;\r
 537                                \r
 538          FI;\r
 539      fi;\r
 540 END SUPPRIME;\r
 541 \r
 542 Unit root:function:arbre;\r
 543 begin\r
 544   result:=racine;\r
 545 end;\r
 546 \r
 547 UNIT reset:procedure(r:arbre);\r
 548 begin\r
 549  if r<>none then\r
 550   if r is feuille then \r
 551      kill(r qua feuille.e);\r
 552      kill(r);\r
 553   else\r
 554      call reset(r qua noeud.arbG);\r
 555 \r
 556      call reset(r qua noeud.arbM);\r
 557      call reset(r qua noeud.arbD);\r
 558      kill(r qua noeud.inf);\r
 559      kill(r qua noeud.sup);\r
 560      kill(r);\r
 561   fi;\r
 562  fi;\r
 563 end reset;\r
 564 UNIT minimum:function(r:arbre):elem;\r
 565 begin\r
 566  if r<>none then\r
 567    if r is feuille then \r
 568       result:=r.getinfo(1);\r
 569    else\r
 570     result:=minimum(r qua noeud.arbG);\r
 571    fi;\r
 572  else result:=none;\r
 573  fi;\r
 574 end minimum;\r
 575 \r
 576 UNIT member: function(per:arbre,value:objet):boolean;\r
 577        var fil:arbre,\r
 578            cettevaleur:objet;\r
 579      Begin\r
 580        if per<>none then\r
 581          if per is noeud then \r
 582            fil:=SousArbre(per,value);\r
 583          else  (* l'arbre est constitu\82 d'une seule feuille *)\r
 584            fil:=per;\r
 585            per:=none;\r
 586          fi;\r
 587        fi;\r
 588     \r
 589     \r
 590       if fil<>none then \r
 591        \r
 592         if fil is noeud then   \r
 593            result:=member(fil,value);  \r
 594         else \r
 595            cettevaleur:=fil.getinfo(leave);\r
 596            result:=(cettevaleur.getvalue=value.getvalue);\r
 597         fi;\r
 598       else\r
 599          result:=false;\r
 600       fi;\r
 601 END member;\r
 602 \r
 603 (**** procedures utilis\82es dans les procedures INSERTION,SUPPRESSION,MEMBER... *******)    \r
 604 \r
 605     Unit ordonne:procedure(valeur:objet,nd,obj:arbre);\r
 606      (* ordonne le noeud "ND" apr\82s insertion du nouvel objet *)\r
 607      (* le noeud comporte alors 3 fils...*)\r
 608      var Lesup,Linf:objet;\r
 609     begin\r
 610          Linf:=nd.getinfo(inf);\r
 611          lesup:=nd.getinfo(sup);\r
 612          if valeur.getvalue<Linf.getvalue then\r
 613               nd qua noeud.arbD:=nd qua noeud.arbM;\r
 614               nd qua noeud.arbM:=nd qua noeud.arbG;\r
 615               nd qua noeud.arbG:=obj;\r
 616          else if lesup.getvalue=-1 then\r
 617                   nd qua noeud.arbM:=obj;\r
 618               else\r
 619               if  valeur.getvalue<Lesup.getvalue then    \r
 620                       nd qua noeud.arbD:=nd qua noeud.arbM;\r
 621                       nd qua noeud.arbM:=obj;\r
 622               else \r
 623                         nd qua noeud.arbD:=obj;\r
 624               fi;\r
 625               fi;\r
 626          fi;\r
 627          nd qua noeud.sup:=supI(nd qua noeud.arbM);\r
 628          nd qua noeud.inf:=supI(nd qua noeud.arbG);\r
 629 \r
 630      end ordonne;\r
 631     \r
 632     \r
 633     UNIT decalle:procedure(n:arbre);\r
 634     begin \r
 635      n qua noeud.arbG:=n qua noeud.arbM;\r
 636      n qua noeud.arbM:=n qua noeud.arbD;\r
 637      n qua noeud.arbD:=none;\r
 638      n qua noeud.inf:=supI(n qua noeud.arbG);\r
 639      n qua noeud.sup:=supI(n qua noeud.arbM);\r
 640     end;\r
 641 \r
 642      UNIT decale:procedure(n:arbre);\r
 643     begin\r
 644      if n qua noeud.arbG=none then\r
 645      n qua noeud.arbG:=n qua noeud.arbM;\r
 646      n qua noeud.arbM:=n qua noeud.arbD;\r
 647      n qua noeud.arbD:=none;\r
 648      else if n qua noeud.arbM=none then\r
 649              n qua noeud.arbM:=n qua noeud.arbD;\r
 650               n qua noeud.arbD:=none;\r
 651              \r
 652           fi;\r
 653      fi;\r
 654      n qua noeud.inf:=supI(n qua noeud.arbG);\r
 655      n qua noeud.sup:=supI(n qua noeud.arbM);\r
 656     end decale;\r
 657     \r
 658     \r
 659     Unit ordre:function(valeur:objet,nd,obj:arbre):arbre;\r
 660     var aux1:arbre,\r
 661         linf,lesup:objet;\r
 662     begin\r
 663          linf:=nd.getinfo(inf);\r
 664          lesup:=nd.getinfo(sup);\r
 665          if valeur.getvalue<linf.getvalue then\r
 666                aux1:=new noeud(supI(obj),supI(nd qua noeud.arbG)); \r
 667                aux1 qua noeud.arbG:=obj;\r
 668                aux1 qua noeud.arbM:=nd qua noeud.arbG;\r
 669                 \r
 670                call decalle(nd);\r
 671          else \r
 672              if valeur.getvalue<lesup.getvalue then\r
 673                aux1:=new noeud(supI(nd qua noeud.arbG),supI(obj)); \r
 674                aux1 qua noeud.arbM:=obj;\r
 675                aux1 qua noeud.arbG:=nd qua noeud.arbG;\r
 676                call decalle(nd);\r
 677              else  \r
 678                if nd qua noeud.arbD.getinfo(2).getvalue<valeur.getvalue then\r
 679                     aux1:=new noeud(supI(nd qua noeud.arbD),valeur); \r
 680                     aux1 qua noeud.arbM:=obj;\r
 681                     aux1 qua noeud.arbG:=nd qua noeud.arbD;\r
 682                nd qua noeud.arbD:=none;\r
 683                else   \r
 684                aux1:=new noeud(valeur,supI(nd qua noeud.arbD)); \r
 685                aux1 qua noeud.arbM:=nd qua noeud.arbD;\r
 686                aux1 qua noeud.arbG:=obj;\r
 687                nd qua noeud.arbD:=none;\r
 688                fi;\r
 689              fi;  \r
 690          fi; \r
 691          result:=aux1;\r
 692     end ordre;\r
 693 \r
 694     Unit supI:function(r:arbre):objet;\r
 695     var theleave:objet;\r
 696     begin\r
 697      if r<>none then\r
 698          \r
 699          if r is feuille then \r
 700                    theleave:=r.getinfo(leave);\r
 701                    result:=theleave;\r
 702          else\r
 703           if r qua noeud.arbD=none then\r
 704                   result:=supI(r qua noeud.arbM);\r
 705           else\r
 706                   result:=supI(r qua noeud.arbD);\r
 707           fi;\r
 708         fi;\r
 709      else\r
 710       result:=none;\r
 711      fi;\r
 712     end supI;\r
 713 \r
 714 (************************************************************************************)\r
 715 \r
 716 Unit inserer: IIUWGRAPH procedure;           \r
 717 var num:file,\r
 718     a:integer;\r
 719 var exist:boolean,\r
 720     d:arbre,\r
 721     rt:elem,\r
 722     components,i:integer;\r
 723 begin           \r
 724   i:=100;\r
 725   do         \r
 726   call move(5,290);\r
 727   call color(grisfonce);\r
 728   call outstring("Element a inserer :");\r
 729            \r
 730   rt:= new elem (ConvEnt(SAISIE(longueur,160,290)));\r
 731   \r
 732   d:=racine;\r
 733   exist:=member(d,rt);\r
 734   if not exist then\r
 735   call insertion(d,rt);\r
 736 \r
 737   else \r
 738   call color(rouge);\r
 739   call move(200,290);\r
 740        call outstring(" ... element existe deja! ...");\r
 741   fi;\r
 742   \r
 743   a:=inchar(2);\r
 744   if a=27 then exit;\r
 745   else \r
 746        if not exist then\r
 747        call move(50,300);\r
 748        call color(bleu);\r
 749        call outstring("===>");\r
 750        \r
 751        call rt.show(i,300); i:=i+22; fi;\r
 752   fi;\r
 753   call move(1,290);\r
 754   call outstring("                                                                ");\r
 755   od;\r
 756   call move(1,290);\r
 757   call outstring("                                                                ");\r
 758   call move(1,300);\r
 759   call outstring("                                                                     ");\r
 760 end inserer;\r
 761 \r
 762 UNIT insertion:procedure(pere:arbre,v:objet);\r
 763 \r
 764    var p,fils:arbre,\r
 765        linf,lesupdupere,lesupduaux:objet;       \r
 766 Begin\r
 767 \r
 768 \r
 769  if pere<>none then\r
 770        \r
 771         \r
 772    if pere is noeud then \r
 773           fils:=SousArbre(pere,v);\r
 774    else  (* l'arbre est constitu\82 d'une seule feuille *)\r
 775            fils:=pere;\r
 776          \r
 777    fi;\r
 778        \r
 779    linf:=fils.getinfo(inf);\r
 780    if fils is feuille then\r
 781         \r
 782         if pere=fils then\r
 783                 racine:=new noeud(v,v);\r
 784                   \r
 785                 if linf.getvalue<v.getvalue then\r
 786                    racine qua noeud.arbG:=fils;\r
 787                    racine qua noeud.arbM:=new feuille(v);\r
 788                 else\r
 789                    racine qua noeud.arbM:=fils;\r
 790                    racine qua noeud.arbG:=new feuille(v);\r
 791                 fi;        \r
 792                 \r
 793                 racine qua noeud.inf:=supI(racine qua noeud.arbG);\r
 794                 racine qua noeud.sup:=supI(racine qua noeud.arbM);\r
 795         else  \r
 796         \r
 797                 if pere qua  noeud.integre then \r
 798                        p:=new feuille(v);\r
 799                        call ordonne(v,pere,p);\r
 800                        eq:=true;\r
 801                 else  (* le noeud comportera plus de trois elements ...*)\r
 802                        eq:=true;   (* il faut donc le rendre "23"*)\r
 803                        aux:=ordre(v,pere,new feuille(v)); \r
 804                        if pere=racine then\r
 805                           racine:=new noeud(v,v);\r
 806                           lesupdupere:=pere.getinfo(sup);     \r
 807                           lesupduaux:=aux.getinfo(sup);\r
 808                           if lesupduPERE.getvalue<lesupduAUX.getvalue then\r
 809                                    racine qua noeud.arbG:=pere;\r
 810                                    racine qua noeud.arbM:=aux;\r
 811                            else\r
 812                                    racine qua noeud.arbM:=pere;\r
 813                                    racine qua noeud.arbG:=aux;\r
 814                            fi;        \r
 815                 \r
 816                           racine qua noeud.inf:=supI(racine qua noeud.arbG);\r
 817                           racine qua noeud.sup:=supI(racine qua noeud.arbM);\r
 818                            eq:=false;\r
 819                            aux:=none;\r
 820                         fi;\r
 821                 fi;  \r
 822         \r
 823         fi;\r
 824    else \r
 825          call insertion(fils,v);\r
 826         \r
 827         if eq then\r
 828            if aux<>none then\r
 829               if pere=racine then\r
 830                 if pere qua noeud.integre then\r
 831                   call ordonne(aux qua noeud.sup,pere,aux);\r
 832                 else\r
 833                   p:=ordre(aux qua noeud.sup,pere,aux);\r
 834                   lesupduPERE:=pere.getinfo(sup);     \r
 835                   lesupduAUX:=p.getinfo(sup);\r
 836                   if LesupduAUX.getvalue>LesupduPERE.getvalue then\r
 837                     racine:=new noeud(pere qua noeud.sup,p qua noeud.sup);\r
 838                     racine qua noeud.arbG:=pere;\r
 839                     racine qua noeud.arbM:=p;\r
 840                   \r
 841                   else\r
 842                    racine:=new noeud(p qua noeud.sup,pere qua noeud.sup);\r
 843                    racine qua noeud.arbM:=pere;\r
 844                    racine qua noeud.arbG:=p;\r
 845                  fi;   \r
 846                                                              \r
 847                fi;\r
 848                  eq:=false;\r
 849                  aux:=none;\r
 850               \r
 851              else\r
 852                 if pere qua noeud.integre then\r
 853                    call ordonne(aux qua noeud.sup,pere,aux);\r
 854                    aux:=none;\r
 855                 else\r
 856                   aux:=ordre(aux qua noeud.sup,pere,aux);\r
 857                 fi;\r
 858              fi;\r
 859           else  (* mise a jour des noeud uniquement*)\r
 860             pere qua noeud.inf:= supI(pere qua noeud.arbG);\r
 861             pere qua noeud.sup:= supI(pere qua noeud.arbM);\r
 862           fi;\r
 863         fi;\r
 864       fi;\r
 865 \r
 866      else\r
 867       racine:=new feuille(v); \r
 868      fi;\r
 869 \r
 870 END insertion;\r
 871      \r
 872 \r
 873 \r
 874 BEGIN    \r
 875 \r
 876 racine:=none;\r
 877 aux:=none;   \r
 878 eq:=false;\r
 879 \r
 880 END arbre23;\r
 881 \r
 882 \r
 883 \r
 884 \r
 885 \r
 886 (*************************    PROGRAMME PRINCIPAL  ******************************)\r
 887 \r
 888 CONST longueur=2,\r
 889       rouge=4,\r
 890       vert=2,\r
 891       marron=6,\r
 892       grisclair=7,\r
 893       grisfonce=8,\r
 894       violet=5,  \r
 895       vertclair=10,\r
 896       bleu=9,\r
 897       sup=2,\r
 898       couleur=3,\r
 899       inf=1,leave=1;\r
 900 \r
 901 VAR i:integer;\r
 902      \r
 903 \r
 904 \r
 905 BEGIN\r
 906    \r
 907  \r
 908  \r
 909  pref iiuwgraph block\r
 910  begin \r
 911   pref arbre23 block\r
 912      var rt:elem;\r
 913   begin \r
 914     call gron(2);\r
 915    do\r
 916    call cls;\r
 917    racine:=root;\r
 918    call affichage(racine);\r
 919    call drawmenu;\r
 920   \r
 921    i:=selectmenu;\r
 922    call move(1,265);\r
 923     call color(rouge);\r
 924    case i\r
 925        when 1: \r
 926              call outstring("               Insertion d'un ou plusieurs elements dans l'arbre");\r
 927              call inserer;\r
 928            \r
 929        when 2:\r
 930               call outstring("             Suppression d'un element dans l'arbre");\r
 931               call move(10,280);\r
 932               call color(rouge);\r
 933               call outstring("element a supprimer:");\r
 934               rt:=new elem(convent(saisie(2,200,280)));\r
 935               call color(grisclair);\r
 936               call move(130,300);\r
 937               if suppression(racine,rt) then \r
 938               call outstring("L'ELEMENT A ETE SUPPRIME !");\r
 939               else\r
 940                 call outstring("L'ELEMENT A SUPPRIMER N'APPARTIENT PAS A L'ARBRE !");\r
 941               fi;\r
 942               i:=inchar(1);\r
 943               kill(rt);\r
 944        when 3:\r
 945               call outstring("            Recherche de l'element minimum appartenant a l'arbre");\r
 946               call move(10,300);\r
 947               call color(grisclair);\r
 948               call outstring("l'element minimum est -->");\r
 949               rt:=minimum(racine);\r
 950               call color(rouge);\r
 951               if rt<>none then\r
 952               call rt.show(250,300);\r
 953               i:=inchar(1);\r
 954               fi;\r
 955        when 4:\r
 956               call outstring("             Interrogation sur l'appartenance d'un element..."); \r
 957               call move(10,280);\r
 958               call color(grisfonce);\r
 959               call outstring("element :");\r
 960               rt:=new elem(convent(saisie(2,200,280)));\r
 961               call move(100,300);\r
 962               call color(grisclair);\r
 963               if member(racine,rt) then \r
 964                              call outstring("L'ELEMENT APPARTIENT A L'ARBRE !");\r
 965               else   call outstring("L'ELEMENT N'APPARTIENT PAS A L'ARBRE !");\r
 966               fi;\r
 967               kill(rt);\r
 968               i:=inchar(1);\r
 969        when 5:  call reset(racine);\r
 970        when 0: exit;\r
 971    esac;\r
 972   od;\r
 973   call reset(racine);\r
 974   kill(rt);\r
 975   call groff; \r
 976    \r
 977   end; (* block arbre23 *)  \r
 978  end; (* block IIUWGRAPH *)\r
 979 \r
 980 \r
 981 END projet2;\r
 982 \r