examples/examples.old/projli11.log

   1 Program Htable;\r
   2 \r
   3 \r
   4 \r
   5 \r
   6 \r
   7 \r
   8 (***************************************************************************)\r
   9 (*                                                                         *)\r
  10 (*      Projet 1 li1 par PAUL olivier et FERNANDEZ raphael                 *)\r
  11 (*                GESTION D'UNE TABLE DE HACHAGE                           *)\r
  12 (*                        le 13-1-1994                                     *)\r
  13 (*                                                                         *)\r
  14 (***************************************************************************)\r
  15 \r
  16 \r
  17 const enter=10,\r
  18       extrnb=8,\r
  19       theta=0.6180339885;\r
  20 \r
  21 \r
  22 (***************************************************************************)\r
  23 (*                                                                         *)\r
  24 (*         Definition d'une classe contenant les principaux                *)\r
  25 (*         Outils utilises par la suite ...                                *)\r
  26 (***************************************************************************)\r
  27 \r
  28 unit tools: class;         (* les outils *)\r
  29 \r
  30 unit inchar:IIUWGraph function:integer;\r
  31  var i:integer;\r
  32 begin\r
  33  do\r
  34   i:=inkey;\r
  35   if i<>0 then exit fi;       (* attend q'un caractere soit saisi et *)\r
  36  od;                             (* renvoie son code *)\r
  37  result:=i;\r
  38 end inchar;\r
  39 \r
  40 unit gotoxy:procedure(col,lig:integer);\r
  41 var c,d,e,f:char,\r
  42  i,j :integer;\r
  43 begin\r
  44  i:=lig div 10;\r
  45  j:=lig mod 10;\r
  46  c:= chr(48+i);           (* positionne le curseur *)\r
  47  d:= chr(48+j);              (* en utilisant le driver ANSI *)\r
  48  i:=col div 10;\r
  49  j:=col mod 10;\r
  50  e:= chr(48+i);\r
  51  f:= chr(48+j);\r
  52  write( chr(27), "[", c, d, ";", e, f, "H")\r
  53 end gotoxy;\r
  54 \r
  55 unit cls : procedure;\r
  56 begin\r
  57  write(chr(27),"[2J");     (* efface l'ecran *)\r
  58 end cls;\r
  59 \r
  60 unit reverse:procedure;\r
  61 begin\r
  62  write( chr(27),"[5m");   (* passe en mode blink *)\r
  63 end reverse;\r
  64 \r
  65 unit normal:procedure;\r
  66 begin\r
  67  write( chr(27),"[0m");  (* passe en mode normal *)\r
  68 end normal;\r
  69 \r
  70 unit box : procedure(x,y,z,w:integer);\r
  71 var i:integer;\r
  72 begin\r
  73  call gotoxy(x,y);\r
  74  write("É");\r
  75  for i:=2 to (z-1) do write("Í") od;\r
  76  write("»");\r
  77  for i:=1 to (w-1) do\r
  78   call gotoxy(x,y+i);      (* affiche une boite au coord x,y *)\r
  79   write("º");              (* de largeur z et de hauteur w *)\r
  80   call gotoxy(x+z-1,y+i);\r
  81   write("º");\r
  82  od;\r
  83  call gotoxy(x,y+w);\r
  84  write("È");\r
  85  for i:=2 to (z-1) do write("Í") od;\r
  86  write("¼");\r
  87 end box;\r
  88 \r
  89 unit line:procedure;\r
  90 var t:integer;\r
  91 begin\r
  92  call gotoxy(1,23);\r
  93  for t:=1 to 79 do write("_") od;\r
  94  call gotoxy(1,24);           (* trace une ligne et positionne le curseur *)\r
  95  for t:=1 to 79 do write(" ") od;\r
  96  call gotoxy(1,24);\r
  97 end line;\r
  98 \r
  99 unit decbin:function(input e:integer):arrayof integer;\r
 100 var f,g:integer;\r
 101 begin\r
 102  array result dim(0:7);\r
 103  for f:=0 to 7 do result(f):=0 od;\r
 104  f:=e;\r
 105  g:=0;            (* convertisseur decimal-binaire *)\r
 106  while (f<>0) do\r
 107   result(g):=f mod 2;\r
 108   f:=f div 2;     (* on utilise les restes de la division par 2 *)\r
 109   g:=g+1;\r
 110  od;\r
 111 end decbin;\r
 112 \r
 113 unit exp:function(x:integer):integer;\r
 114 var t:integer;\r
 115 begin\r
 116  result:=1;                           (* calcule 2^x *)\r
 117  for t:=1 to x do result:=result*2 od;\r
 118 end exp;\r
 119 \r
 120 unit bindec:function(input e:arrayof integer;l:integer):integer;\r
 121 var i,res:integer;\r
 122 begin\r
 123  i:=0;\r
 124  result:=0;\r
 125  while (i<l) do\r
 126   result:=result+exp(i)*e(i); (* conversion binaire-decimal *)\r
 127   i:=i+1;\r
 128  od;\r
 129 end bindec;\r
 130 \r
 131 unit delay:procedure;\r
 132 begin\r
 133  call line;            (* attend qu 'une touche soit pressee *)\r
 134  write("Appuyez sur une touche pour la suite");\r
 135  while inchar=0 do od;\r
 136 end delay;\r
 137 \r
 138 end tools;\r
 139 \r
 140 \r
 141 (***************************************************************************)\r
 142 (*                                                                         *)\r
 143 (*         Definition des elements et des operations s'y rapportant        *)\r
 144 (*                                                                         *)\r
 145 (***************************************************************************)\r
 146 \r
 147 unit dicob : class; (* le type d 'element saisi *)\r
 148 var mot :arrayof char, (* un mot de 25 lettres max *)\r
 149    trad :arrayof char; (* sa traduction en anglais *)\r
 150 begin\r
 151  array mot dim (1:25);\r
 152  array trad dim (1:100);\r
 153 end dicob;\r
 154 \r
 155 unit newdicob : function : dicob; (* cree un nouvel element *)\r
 156 var t:integer;\r
 157 begin\r
 158  result:=new dicob;\r
 159  for t:=1 to 100 do result.trad(t):=' ' od; (* et l 'initialise *)\r
 160  for t:=1 to 25 do result.mot(t):=' ' od;\r
 161 end newdicob;\r
 162 \r
 163 unit readel : tools function(f:file) : dicob;\r
 164 var t:integer,         (* lit un element *)\r
 165     c:char,\r
 166  tamp:dicob;\r
 167 begin\r
 168  if (f=NONE) then\r
 169   call line;\r
 170   write("saisissez votre mot puis <enter> pour valider");\r
 171   call box(1,15,79,2);      (* si l' element provient du clavier *)\r
 172   call gotoxy(2,16);        (* on agremente la presentation *)\r
 173   write("mot : ");\r
 174  fi;\r
 175  t:=1;\r
 176  if (f<>NONE) then read(f,c) else read(c) fi;\r
 177  if (ord(c)=enter) then read(c) fi;\r
 178  tamp:=newdicob;\r
 179  if (f<>NONE) then              (* saisie du nom *)\r
 180   while ((t<24) and not(eoln(f)))\r
 181    do\r
 182     tamp.mot(t):=c;              (* si l' element provient d'un fichier *)\r
 183     read(f,c);\r
 184     t:=t+1;\r
 185    od;\r
 186  else\r
 187   while ((t<24) and (ord(c)<>enter))\r
 188    do\r
 189     tamp.mot(t):=c;\r
 190     read(c);            (* si l' element provient du clavier *)\r
 191     t:=t+1;\r
 192    od;\r
 193   if (t=24) then readln fi;\r
 194  fi;\r
 195  tamp.mot(t):=c;\r
 196  tamp.mot(t+1):=chr(enter); (* on en marque la fin par enter *)\r
 197  if (f<>NONE) then readln(f) fi;\r
 198  if (f=NONE) then\r
 199   call cls;\r
 200   call line;\r
 201   write("saisissez votre mot puis <enter> pour valider");\r
 202   call box(1,15,79,3);           (* si l' element provient du clavier *)\r
 203   call gotoxy(2,16);\r
 204   write("traduction : ");\r
 205  fi;\r
 206  t:=1;\r
 207  if (f<>NONE) then read(f,c) else read(c) fi;\r
 208  if (f<>NONE) then              (* saisie de la traduction *)\r
 209   while ((t<100) and not(eoln(f)))\r
 210    do\r
 211     tamp.trad(t):=c;\r
 212     read(f,c);                  (* si l' element provient d'un fichier *)\r
 213     t:=t+1;\r
 214    od;\r
 215  else\r
 216   while ((t<100) and (ord(c)<>enter))\r
 217    do\r
 218     tamp.trad(t):=c;\r
 219     read(c);                     (* si l' element provient du clavier *)\r
 220     t:=t+1;\r
 221    od;\r
 222  fi;\r
 223  tamp.trad(t):=c;\r
 224  tamp.trad(t+1):=chr(enter);     (* on en marque la fin par enter *)\r
 225  if (f<>NONE) then readln(f) fi;\r
 226  result:=tamp;\r
 227 end readel;\r
 228 \r
 229 unit writel : tools procedure(e:dicob);(* ecriture de l 'element *)\r
 230 var t:integer;\r
 231 begin\r
 232  t:=1;\r
 233  call box(1,15,79,3);\r
 234  call gotoxy(2,16);\r
 235  while ((ord(e.mot(t))<>enter) and (t<=25))\r
 236   do\r
 237     write(e.mot(t));         (* ecriture du mot *)\r
 238     t:=t+1;\r
 239   od;\r
 240  write(" se traduit par ");\r
 241  t:=1;\r
 242  while ((ord(e.trad(t))<>enter) and (t<=25))\r
 243   do\r
 244     write(e.trad(t));       (* et de la traduction *)\r
 245     t:=t+1;\r
 246   od;\r
 247 end writel;\r
 248 \r
 249 unit supel :function(e1:dicob,e2:dicob):boolean;\r
 250 var t:integer,\r
 251   res:integer;\r
 252 begin                       (* cherche si e1>e2 *)\r
 253  res:=0; (* res=0 si e1=e2 ,res=-1 si e2>e1,res=1 si e1>e2 *)\r
 254  t:=1;\r
 255  while ((t<25) and (res=0) and (ord(e1.mot(t))<>enter)\r
 256  and (ord(e2.mot(t))<>enter))\r
 257   do\r
 258    if (ord(e1.mot(t))<ord(e2.mot(t))) then res:=-1 fi;\r
 259    if (ord(e1.mot(t))>ord(e2.mot(t))) then res:=1 fi;\r
 260    t:=t+1;\r
 261   od;\r
 262  if (ord(e1.mot(t))=enter) and (ord(e2.mot(t))<>enter) and (res=0)\r
 263   then res:=-1 fi; (* le plus long est le plus grand *)\r
 264  if (ord(e2.mot(t))=enter) and (ord(e1.mot(t))<>enter) and (res=0)\r
 265   then res:=1 fi;   (* idem *)\r
 266  result:=(res=1);\r
 267 end supel;\r
 268 \r
 269 unit egalel :function(input e1,e2:dicob):boolean;\r
 270 var t:integer, (* cherche si deux elements sont egaux *)\r
 271   res:integer;\r
 272 begin\r
 273  res:=0;\r
 274  t:=1;\r
 275  while ((t<25) and (res=0) and (ord(e1.mot(t))<>enter)\r
 276  and (ord(e2.mot(t))<>enter))\r
 277   do\r
 278    if (e1.mot(t)<>e2.mot(t)) then res:=1 fi;\r
 279    t:=t+1;\r
 280   od;\r
 281  if (ord(e1.mot(t))<>ord(e2.mot(t))) then res:=1 fi;\r
 282  result:=(res=0);\r
 283 end egalel;\r
 284 \r
 285 unit extraction : tools function(e1:dicob;long:integer):integer;\r
 286 var t:integer,      (* function de hachage par extraction *)\r
 287     tamp:arrayof integer,\r
 288     rep:arrayof arrayof integer;\r
 289 begin\r
 290  array tamp dim(0:31);\r
 291  for t:=0 to 31 do tamp(t):=0 od;\r
 292  array rep dim(1:extrnb);\r
 293  for t:=1 to extrnb do rep(t):=decbin(ord(e1.mot(t))) od;(* conversion *)\r
 294  for t:=1 to extrnb do tamp(t-1):=rep(t)(t-1) od;(*on prend les extrnb*)\r
 295  result:=((bindec(tamp,32) mod long)+1);(* premiers bits *)\r
 296  (* voir remarque fonction suivante pour mod *)\r
 297  kill(tamp);\r
 298  for t:=1 to extrnb do kill(rep(t)) od;\r
 299 end extraction;\r
 300 \r
 301 unit compression : tools function(e1:dicob;long:integer):integer;\r
 302 var t,l,nb0,nb1,u:integer, (* function de hachage par compression *)\r
 303     tamp:arrayof integer,\r
 304     rep:arrayof arrayof integer;\r
 305 begin\r
 306  array tamp dim(0:7);\r
 307  for t:=0 to 7 do tamp(t):=0 od;\r
 308  l:=1;\r
 309  while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;\r
 310  l:=l-1; (* longueur du mot *)\r
 311  array rep dim(1:l+1);\r
 312  for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od;\r
 313  for u:=0 to 7 do\r
 314   nb0:=0;nb1:=0;\r
 315   for t:=1 to l do\r
 316    if (rep(t)(u)=0) then nb0:=nb0+1 fi;  (* on calcule le nombre de 1 et *)\r
 317    if (rep(t)(u)=1) then nb1:=nb1+1 fi;  (* de 0 pour chaque bit *)\r
 318   od;\r
 319   if ((nb1 mod 2)=1) then tamp(u):=1   (* Xor *)\r
 320   else tamp(u):=0 fi;\r
 321  od;\r
 322  result:=((bindec(tamp,8) mod long)+1);(* reconversion*)\r
 323  kill(tamp);\r
 324  for t:=1 to l do kill(rep(t)) od;\r
 325 end compression;(*le mod permet de prendre une longueur de tableau variable*)\r
 326                      (* au detriment de la "precision" de la fonction *)\r
 327 \r
 328 unit division : tools function(e1:dicob;long:integer):integer;\r
 329 var t,l,u,v:integer,      (* function de hachage par division *)\r
 330     tamp:arrayof integer,\r
 331     rep:arrayof arrayof integer;\r
 332 begin\r
 333  l:=1;\r
 334  while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;\r
 335  l:=l-1;\r
 336  array rep dim(1:l+1);\r
 337  array tamp dim(0:8*(l));\r
 338  for t:=0 to 8*l-1 do tamp(t):=0 od;\r
 339  for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od; (* conversion *)\r
 340  u:=1;\r
 341  v:=0;\r
 342  for t:=0 to 8*l-1 do\r
 343   tamp(t):=rep(u)(v);\r
 344   v:=v+1;\r
 345   if (v=8) then      (* on recopie les conversions dans un seul tableau *)\r
 346    v:=0;\r
 347    u:=u+1;\r
 348   fi;\r
 349  od;\r
 350  result:=(bindec(tamp,8*l) mod long)+1; (* que l 'on convertit *)\r
 351  kill(tamp);\r
 352  for t:=1 to l+1 do kill(rep(t)) od;\r
 353 end division;\r
 354 \r
 355 unit multiplication : tools function(e1:dicob;long:integer):integer;\r
 356 var pos:real,  (* function de hachage par multiplication *)\r
 357     t,l,u,v:integer,\r
 358     tamp:arrayof integer,\r
 359     rep:arrayof arrayof integer;\r
 360 begin\r
 361  l:=1;\r
 362  while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;\r
 363  l:=l-1;\r
 364  array rep dim(1:l+1);\r
 365  array tamp dim(0:8*(l));\r
 366  for t:=0 to 8*l-1 do tamp(t):=0 od;\r
 367  for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od;\r
 368  u:=1;\r
 369  v:=0;                        (* idem division *)\r
 370  for t:=0 to 8*l-1 do\r
 371   tamp(t):=rep(u)(v);\r
 372   v:=v+1;\r
 373   if (v=8) then\r
 374    v:=0;\r
 375    u:=u+1;\r
 376   fi;\r
 377  od;\r
 378  pos:=bindec(tamp,8*l)*theta; (* conversion *)\r
 379  result:=(entier((pos-entier(pos))*long)+1);\r
 380  kill(tamp);\r
 381  for t:=1 to l+1 do kill(rep(t)) od;\r
 382 end multiplication;\r
 383 \r
 384 (***************************************************************************)\r
 385 (*                                                                         *)\r
 386 (*         Definition de la classe table ainsi que des operations          *)\r
 387 (*         utilisees par celle-ci ...                                      *)\r
 388 (***************************************************************************)\r
 389 \r
 390 unit table : tools class (type elem;function newelem:elem;\r
 391 function egalelem(e1,e2:elem):boolean;function readelem(f:file):elem;\r
 392 function supelem(e1,e2:elem):boolean;\r
 393 function hachelem(e1:elem;l:integer):integer;procedure writelem(e:elem));\r
 394 \r
 395 unit tree: class (el: elem); (* definition d 'un arbre binaire de recherche *)\r
 396  var left,right: tree;\r
 397 end tree;\r
 398 \r
 399 unit max:function (input t:tree):tree;\r
 400 var tamp:tree,\r
 401    continue:boolean;\r
 402 begin\r
 403  continue:=TRUE;\r
 404  if (t=NONE) then\r
 405   continue:=FALSE;\r
 406   tamp:=NONE;      (* calcule le plus grand element d 'un arbre *)\r
 407  else\r
 408   tamp:=t;\r
 409   while continue\r
 410   do\r
 411      if (tamp.right<>NONE) then\r
 412       tamp:=tamp.right;     (* celui-ci se trouve en bas a droite *)\r
 413      else continue:=FALSE;\r
 414      fi;\r
 415   od;\r
 416  fi;\r
 417  result:=tamp;\r
 418  call line;\r
 419  writeln("maximum trouve ... fait.");\r
 420 end max;\r
 421 \r
 422 unit find:function(input t:tree;e:elem):tree;\r
 423 var tamp: tree,\r
 424  continue,ok :boolean; (* recherche d 'un elemnt *)\r
 425 begin\r
 426  continue:=TRUE;\r
 427  if (t=NONE) then\r
 428   tamp:=NONE;\r
 429   ok:=FALSE;\r
 430  else\r
 431   tamp:=t;\r
 432   ok:=FALSE;\r
 433   while continue\r
 434   do\r
 435     if supelem(e,tamp.el) then\r
 436      if (tamp.right<>NONE) then\r
 437       tamp:=tamp.right; (* si l'arbre courant est plus petit on va a droite *)\r
 438      else continue:=FALSE;\r
 439      fi;\r
 440     else\r
 441      if egalelem(e,tamp.el) then\r
 442       continue:=FALSE; (* si l'arbre courant est celui recherche on arrete *)\r
 443       ok:=TRUE;\r
 444      else\r
 445       if (tamp.left<>NONE) then\r
 446         tamp:=tamp.left; (* sinon on va a gauche *)\r
 447       else continue:=FALSE;\r
 448       fi;\r
 449      fi;\r
 450     fi;\r
 451   od;\r
 452  fi;\r
 453  call line;\r
 454  writeln("element trouve ... fait.");\r
 455  if ok then result:=tamp;\r
 456  else result:=NONE fi;\r
 457 end find;\r
 458 \r
 459 unit add: function (input t: tree; e: elem):tree;\r
 460  var tamp1,tamp2: tree,\r
 461  continue :boolean; (* ajout d 'un element a un arbre *)\r
 462 begin\r
 463  continue:=TRUE;\r
 464  if (t=NONE) then\r
 465   t:=new tree(e);\r
 466   continue:=FALSE;\r
 467  else\r
 468   tamp1:=t;\r
 469   while continue\r
 470   do\r
 471     if supelem(e,tamp1.el) then\r
 472      if (tamp1.right<>NONE) then\r
 473       tamp1:=tamp1.right; (* idem recherche *)\r
 474      else continue:=FALSE fi;\r
 475     else\r
 476      if (tamp1.left<>NONE) then\r
 477       tamp1:=tamp1.left;\r
 478      else continue:=FALSE fi;\r
 479     fi;\r
 480   od;\r
 481   tamp2:=new tree(e);(* on cree un nouvel arbre *)\r
 482   tamp2.left:=NONE;\r
 483   tamp2.right:=NONE;\r
 484   if supelem(e,tamp1.el) then tamp1.right:=tamp2;\r
 485   else tamp1.left:=tamp2 fi;(*on le place*)\r
 486   call line;\r
 487   writeln("ajout classique ... fait.");\r
 488  fi;\r
 489  result:=t;\r
 490 end add;\r
 491 \r
 492 unit last:function(input t:tree;input e:tree;output r:boolean):tree;\r
 493 var tamp: tree, (* recherche l'element precedent un autre *)\r
 494  continue,ok :boolean;\r
 495 begin\r
 496  continue:=TRUE;\r
 497  ok:=FALSE;\r
 498  if (t=NONE) then\r
 499   ok:=FALSE;\r
 500  else\r
 501   tamp:=t;\r
 502   while continue\r
 503    do\r
 504      if (tamp.right<>NONE) then\r
 505       if egalelem(e.el,tamp.right.el) then\r
 506        continue:=FALSE;\r
 507        ok:=TRUE; (* idem recherche mais avec 2 possibilites *)\r
 508        r:=TRUE;\r
 509       fi;\r
 510      fi;\r
 511      if (tamp.left<>NONE) then\r
 512       if egalelem(e.el,tamp.left.el) then\r
 513        continue:=FALSE;\r
 514        ok:=TRUE;\r
 515        r:=FALSE;\r
 516       fi;\r
 517      fi;\r
 518      if not(ok) then\r
 519       if supelem(e.el,tamp.el) then\r
 520        if (tamp.right<>NONE) then\r
 521         tamp:=tamp.right;\r
 522        else continue:=FALSE;          (* deplacement *)\r
 523        fi;\r
 524       else\r
 525        if (tamp.left<>NONE) then\r
 526          tamp:=tamp.left;\r
 527        else continue:=FALSE;\r
 528        fi;\r
 529       fi;\r
 530      fi;\r
 531    od;\r
 532  fi;\r
 533  call line;\r
 534  writeln("element precedent trouve ... fait.");\r
 535  if ok then result:=tamp;\r
 536  else result:=NONE fi;\r
 537 end last;\r
 538 \r
 539 unit sub: function (input t: tree;e:elem):tree;\r
 540 var tamp2,tamp3,pred1,pred2: tree,\r
 541     r1,r2:boolean; (* on enleve une element a un arbre *)\r
 542 begin\r
 543   tamp2:=find(t,e);     (* on recherche la place de l' element *)\r
 544   pred1:=last(t,tamp2,r1);(* son pere *)\r
 545   if (tamp2<>NONE) then\r
 546    if (tamp2=t) and (tamp2.left=NONE) then\r
 547       t:=tamp2.right;\r
 548    else\r
 549     if (tamp2.left=NONE) then\r
 550      if r1 then\r
 551       pred1.right:=tamp2.right;\r
 552      else\r
 553       pred1.left:=tamp2.right;    (* on raccorde *)\r
 554      fi;\r
 555      kill(tamp2);\r
 556     else\r
 557      tamp3:=max(tamp2.left);(* on cherche le max du sous arbre gauche *)\r
 558      pred2:=last(t,tamp3,r2);(* et son pere *)\r
 559      if (tamp3<>NONE) then\r
 560       if r1 then\r
 561          if (pred1<>NONE) then pred1.right:=tamp3;\r
 562          else t:=tamp3;\r
 563          fi;\r
 564          if (pred2<>tamp2) then pred2.right:=tamp3.left fi;\r
 565          tamp3.right:=tamp2.right;\r
 566          tamp3.left:=pred2;                   (* on connecte *)\r
 567        else\r
 568          if (pred1<>NONE) then pred1.left:=tamp3;\r
 569          else t:=tamp3;\r
 570          fi;\r
 571          if (pred2<>tamp2) then pred2.right:=tamp3.left fi;\r
 572          tamp3.right:=tamp2.right;\r
 573          tamp3.left:=pred2;\r
 574       fi;\r
 575      fi;\r
 576       kill(tamp2);\r
 577     fi;\r
 578    fi;\r
 579  else\r
 580   call line;\r
 581   writeln("element non touve ...");\r
 582  fi;\r
 583  call line;\r
 584  writeln("deletion terminee ... fait.");\r
 585  result:=t;\r
 586 end sub;\r
 587 \r
 588 unit proof:function(input t:tree):integer;\r
 589 begin (* calcule la profondeur d 'un arbre recursivement*)\r
 590  if t<>NONE then\r
 591    result:=imax(proof(t.left),proof(t.right))+1;\r
 592  else(* proof=max(proof(arbredroit),proof(arbregauche)) *)\r
 593   result:=0;\r
 594  fi;\r
 595 end;\r
 596 \r
 597 unit total:procedure(input t:tree;input x,y,z:integer;input current:tree);\r
 598 var i:integer;(* affiche un arbre recursivement *)\r
 599 begin\r
 600  if (t<>NONE) then\r
 601   if (t.right<>NONE) and (t.left=NONE) then\r
 602     call gotoxy(x,y);\r
 603     write("e");\r
 604     y:=y+1;          (* si le sous arbre droit existe on l' affiche *)\r
 605     call gotoxy(x,y);\r
 606     write("Ê");\r
 607     for i:=2 to (exp(z-2)) do write("Í") od;\r
 608     x:=x+exp(z-2);\r
 609     call total(t.right,x,y,z-1,current);\r
 610   fi;\r
 611   if (t.left<>NONE) and (t.right=NONE) then\r
 612     call gotoxy(x,y);\r
 613     write("e");\r
 614     y:=y+1;         (* si le sous arbre gauche existe on l' affiche *)\r
 615     call gotoxy(x-exp(z-2),y);\r
 616     for i:=1 to (exp(z-2)) do write("Í") od;\r
 617     write("Ê");\r
 618     x:=x-exp(z-2);\r
 619     call total(t.left,x,y,z-1,current);\r
 620   fi;\r
 621   if (t.left<>NONE) and (t.right<>NONE) then\r
 622     call gotoxy(x,y);\r
 623     write("e");\r
 624     y:=y+1;\r
 625     call gotoxy(x,y);(* si les deux existent on les affiche les deux *)\r
 626     write("Ê");\r
 627     for i:=2 to (exp(z-2)) do write("Í") od;\r
 628     x:=x+exp(z-2);\r
 629     call total(t.right,x,y,z-1,current);\r
 630     y:=y-1;\r
 631     x:=x-exp(z-2);\r
 632     call gotoxy(x,y);\r
 633     write("e");\r
 634     y:=y+1;\r
 635     call gotoxy(x-exp(z-2),y);\r
 636     for i:=1 to (exp(z-2)) do write("Í") od;\r
 637     write("Ê");\r
 638     x:=x-exp(z-2);\r
 639     call total(t.left,x,y,z-1,current);\r
 640   fi;\r
 641     call gotoxy(x,y);(* sinon on affiche l'element *)\r
 642     write("e");\r
 643  fi;\r
 644 end total;\r
 645 \r
 646 unit tableau : procedure (input e,f:integer);\r
 647 begin (* on affiche le tableau correspondant au code de hachage *)\r
 648  if ((e<f) or (e=f)) and ((e>1) or (e=1)) then\r
 649      call box(30,10,10,10);\r
 650      call gotoxy(31,15); (* tableau recherche *)\r
 651      call reverse;\r
 652      write(e);\r
 653      call normal;\r
 654  fi;\r
 655  if (e+1<f) or (e+1=f) then\r
 656      call box(50,10,10,10); (* le suivant *)\r
 657      call gotoxy(51,15);\r
 658      write(e+1);\r
 659  fi;\r
 660  if (e-1>1) or (e-1=1) then\r
 661      call box(10,10,10,10); (* le precedent *)\r
 662      call gotoxy(11,15);\r
 663      write(e-1);\r
 664  fi;\r
 665 end tableau;\r
 666 \r
 667 unit newtable : function (input long : integer) :arrayof tree;\r
 668 var t : integer;(* cree une nouvelle table *)\r
 669 begin\r
 670  array result dim (1:long);\r
 671  for t:=1 to long do result(t):=NONE od;\r
 672  call line;\r
 673  writeln("table initialisee ... fait.");\r
 674 end newtable;\r
 675 \r
 676 unit ajoute :function(input T:arrayof tree;long:integer):arrayof tree;\r
 677 var lg,pos:integer, (* ajoute un element a la table *)\r
 678      e:elem,\r
 679   current:tree;\r
 680 begin\r
 681  e:=readelem(none); (* lit l'element *)\r
 682  call cls;\r
 683  pos:=hachelem(e,long);(* calcule son hach code *)\r
 684  call line;\r
 685  writeln("hach code calcule ... fait. ",pos);\r
 686  call tableau(pos,long);(* marque sa position *)\r
 687  call line;\r
 688  writeln("tableau designe ... fait.");\r
 689  current:=find(T(pos),e);(* le cherche *)\r
 690  if (current=NONE) then\r
 691   T(pos):=add(T(pos),e);(* s'il n'existe pas l'ajoute *)\r
 692   call line;\r
 693   writeln("element ajoute ... fait.");\r
 694   call cls;\r
 695   lg:=proof(T(pos)); (* calcule la profondeur de l'arbre *)\r
 696   if lg<6 then call total(T(pos),40,1,lg,current) else  (* affiche l'arbre *)\r
 697    call line;\r
 698    write("l'arbre est trop grand pour etre imprime ...");\r
 699   fi;\r
 700  else\r
 701   call cls;\r
 702   writeln("element deja stocke ...");\r
 703  fi;\r
 704   result:=T;\r
 705   call delay;(* attend que l'utilisateur ai vu l'arbre *)\r
 706 end ajoute;\r
 707 \r
 708 unit supp :function(input T:arrayof tree;long:integer):arrayof tree;\r
 709 var lg,pos:integer,(* supprime un element *)\r
 710     e:elem,\r
 711     current:tree;\r
 712 begin\r
 713  e:=readelem(none);     (* idem ajoute *)\r
 714  call cls;\r
 715  pos:=hachelem(e,long);\r
 716  call line;\r
 717  writeln("hach code calcule ... fait. ",pos);\r
 718  call tableau(pos,long);\r
 719  call line;\r
 720  writeln("tableau designe ... fait.");\r
 721  current:=find(T(pos),e);\r
 722  if (current<>NONE) then\r
 723    T(pos):=sub(T(pos),e);\r
 724    call line;\r
 725    writeln("element detruit ... fait.");\r
 726    call cls;\r
 727    lg:=proof(T(pos));\r
 728    if lg<6 then call total(T(pos),40,1,lg,current) else\r
 729      call line;\r
 730      write("l'arbre est trop grand pour etre imprime ...");\r
 731    fi;\r
 732   else\r
 733    call cls;\r
 734    writeln("non trouve ...");\r
 735  fi;\r
 736  call delay;\r
 737  result:=T;\r
 738 end supp;\r
 739 \r
 740 unit recherche :procedure(input T:arrayof tree;long:integer);\r
 741 var pos:integer,(* recherche un element dans la table *)\r
 742   current:tree,\r
 743       e:elem;\r
 744 begin\r
 745  e:=readelem(none);(* idem ajoute *)\r
 746  call cls;\r
 747  pos:=hachelem(e,long);\r
 748  call line;\r
 749  writeln("hach code calcule ... fait. ",pos);\r
 750  call tableau(pos,long);\r
 751  call line;\r
 752  writeln("tableau designe ... fait.");\r
 753  current:=find(T(pos),e);\r
 754  call cls;\r
 755  if (current<>NONE) then call writelem(current.el);(* ecrit le resultat *)\r
 756  else writeln("non trouve ...") fi;(* de la recherche *)\r
 757  call line;\r
 758  writeln("recherche terminee ... fait.");\r
 759  call delay;\r
 760 end recherche;\r
 761 \r
 762 unit demo :function(input T:arrayof tree;long:integer):arrayof tree;\r
 763 var fich:file,(*stocke automatiquement des elements contenus dans un fichier*)\r
 764  c:char,\r
 765  pos,lg:integer,\r
 766  e:elem,\r
 767  current:tree;\r
 768 begin\r
 769  open(fich,text,unpack("data.dem"));(* on ouvre le fichier *)\r
 770  call line;\r
 771  writeln("ouverture du fichier ... fait.");\r
 772  call reset(fich);                   (* en lecture *)\r
 773  while not(eof(fich))\r
 774   do\r
 775    e:=readelem(fich);(* idem ajoute *)\r
 776    pos:=hachelem(e,long);\r
 777    call line;\r
 778    writeln("hach code calcule ... fait. ");\r
 779    call tableau(pos,long);\r
 780    call line;\r
 781    writeln("tableau designe ... fait.");\r
 782    current:=find(T(pos),e);\r
 783    if (current=NONE) then\r
 784      T(pos):=add(T(pos),e);\r
 785      call line;\r
 786      writeln("element ajoute ... fait.");\r
 787      lg:=proof(T(pos));\r
 788      call cls;\r
 789      if lg<6 then call total(T(pos),40,1,lg,current) else\r
 790       call line;\r
 791       write("l'arbre est trop grand pour etre imprime ...");\r
 792      fi;\r
 793      call line;\r
 794      writeln("arbre imprime ... fait.");\r
 795    else\r
 796      call cls;\r
 797      writeln("element deja stocke ...");\r
 798    fi;\r
 799   od;\r
 800  result:=T;\r
 801 end demo;\r
 802 \r
 803 unit numb:function(input T:tree):integer;\r
 804 begin (* calcule le nombre de sommets par arbre recursivement *)\r
 805  if (T<>NONE) then\r
 806   result:=numb(T.left)+numb(T.right);\r
 807  else (* nbsom=nbsom(arbregauche)+nbsom(arbredroit) *)\r
 808   result:=1;\r
 809  fi;\r
 810 end numb;\r
 811 \r
 812 unit stats:procedure(input T:arrayof tree;long:integer);\r
 813 var u,s1,s2,s3,max1,max2:integer,\r
 814     s,v:arrayof integer;(* calcule quelques satistiques sur les donnees *)\r
 815                            (* stockees dans la table *)\r
 816 begin\r
 817  s1:=0;s2:=0;s3:=0;\r
 818  array s dim(1:long);\r
 819  array v dim(1:long);\r
 820  for u:=1 to long do\r
 821    if (T(u)<>NONE) then\r
 822     s1:=s1+1;(* nombre d'arbre utilises *)\r
 823     s(u):=numb(T(u))-1;\r
 824     v(u):=proof(T(u));\r
 825     s2:=s2+s(u);(* nombre total de sommets *)\r
 826     s3:=s3+v(u);(* profondeur totale de la table *)\r
 827    fi;\r
 828  od;\r
 829  max1:=1;max2:=1;\r
 830  for u:=1 to long do\r
 831   if (s(u)>s(max1)) then max1:=u fi;\r
 832   if (v(u)>s(max2)) then max2:=u fi;\r
 833  od;\r
 834  call cls;\r
 835  call gotoxy(10,5);\r
 836  write("Nombre Total de sommets :",s2);\r
 837  call gotoxy(10,7);\r
 838  write("Nombre Total d 'arbres non vides :",s1);\r
 839  if s1<>0 then\r
 840   call gotoxy(10,9);\r
 841   write("Nombre moyen de sommet par arbre :",s2/s1);\r
 842   call gotoxy(10,15);\r
 843   write("Profondeur moyenne :",s3/s1);\r
 844  else\r
 845   call gotoxy(10,9);\r
 846   write("Tableau non rempli ...");\r
 847  fi;\r
 848  call gotoxy(10,11);\r
 849  write("Nombre de sommets de l'Arbre le plus important :",s(max1));\r
 850  call gotoxy(10,13);\r
 851  write("Profondeur de l'Arbre le plus grand :",v(max2));\r
 852  call box(7,3,70,15);\r
 853  call line;\r
 854  write("stats calculees ... fait.");\r
 855  call delay;\r
 856 end stats;\r
 857 \r
 858 \r
 859 unit op:procedure(size:integer);\r
 860 var T:arrayof tree, (* menu *)\r
 861     c,i:integer;\r
 862 begin\r
 863      T:=newtable(size);\r
 864      while (i<>6) do\r
 865       call cls;\r
 866       call line;\r
 867       write("utilisez les fleches  haut/bas pour vous deplacer, droite pour\r
 868       valider");\r
 869       call gotoxy(1,7);\r
 870       i:=1;\r
 871       c:=0;\r
 872       writeln("               Inserer un element");writeln;\r
 873       writeln("               Rechercher un element");writeln;\r
 874       writeln("               Supprimer un element");writeln;\r
 875       writeln("               Demo");writeln;\r
 876       writeln("               Statistiques");writeln;\r
 877       writeln("               Quitter");writeln;\r
 878       call box(5,4,50,17);\r
 879       call box(10,4+2*i,35,2);\r
 880       while (c<>-77) do\r
 881        c:=inchar;\r
 882         if (c=-80) or (c=-72) then\r
 883          call gotoxy(10,4+2*i);\r
 884          write("                                            ");\r
 885          call gotoxy(10,4+2*(i+1));\r
 886          write("                                            ");\r
 887          call gotoxy(10,4+2*i+1);\r
 888          write("  ");\r
 889          call gotoxy(44,4+2*i+1);\r
 890          write("  ");\r
 891          if (c=-80) then i:=i+1 fi;\r
 892          if (c=-72) then i:=i-1 fi;\r
 893          if (i=7) then i:=1 fi;\r
 894          if (i=0) then i:=6 fi;\r
 895          call box(10,4+2*i,35,2);\r
 896         fi;\r
 897         od;\r
 898         call cls;\r
 899         case i\r
 900          when 1 :T:=ajoute(T,size);\r
 901          when 2 :call recherche(T,size);\r
 902          when 3 :T:=supp(T,size);\r
 903          when 4 :T:=demo(T,size);\r
 904          when 5 :call stats(T,size);\r
 905         esac;\r
 906       od;\r
 907      writeln("operations terminees ... fait.");\r
 908 end op;\r
 909 \r
 910 end table;\r
 911 \r
 912 \r
 913 (***************************************************************************)\r
 914 (*                                                                         *)\r
 915 (*                   PROGRAMME PRINCIPAL                                   *)\r
 916 (*                                                                         *)\r
 917 (***************************************************************************)\r
 918 \r
 919 var stTable:table,\r
 920        size,algo,i:integer,\r
 921        c:integer;\r
 922 begin (* prog principal *)\r
 923  i:=1;\r
 924  while (i<>5) do\r
 925   pref tools block\r
 926    begin\r
 927      call cls;\r
 928      call line;\r
 929      write("utilisez les fleches  haut/bas pour vous deplacer, droite pour\r
 930      valider");\r
 931      call gotoxy(1,7);\r
 932      writeln("               EXTRACTION");writeln;\r
 933      writeln("               COMPRESSION");writeln;\r
 934      writeln("                DIVISION");writeln;\r
 935      writeln("              MULTIPLICATION");writeln;\r
 936      writeln("                 QUITTER");writeln;\r
 937      call box(5,4,50,15);\r
 938      call box(10,4+2*i,35,2);\r
 939      while (c<>-77) do\r
 940       c:=inchar;\r
 941       if (c=-80) or (c=-72) then\r
 942        call gotoxy(10,4+2*i);\r
 943        write("                                            ");\r
 944        call gotoxy(10,4+2*(i+1));\r
 945        write("                                            ");\r
 946        call gotoxy(10,4+2*i+1);\r
 947        write("  ");\r
 948        call gotoxy(44,4+2*i+1);\r
 949        write("  ");\r
 950        if (c=-80) then i:=i+1 fi;\r
 951        if (c=-72) then i:=i-1 fi;\r
 952        if (i=6) then i:=1 fi;\r
 953        if (i=0) then i:=5 fi;\r
 954        call box(10,4+2*i,35,2);\r
 955       fi;\r
 956      od;\r
 957      call cls;\r
 958      if (i<>5) then\r
 959       call cls;\r
 960       call line;\r
 961       write("!! (petites tailles)+(beaucoup d'elts)=(pbs de memoire)");\r
 962       call box(20,15,35,2);\r
 963       call gotoxy(21,16);\r
 964       write("taille du tableau desire : ");\r
 965       read(size);\r
 966      fi;\r
 967      call cls;\r
 968      c:=0;\r
 969    end;\r
 970   if (i=1) then\r
 971    pref table(dicob,newdicob,egalel,readel,supel,extraction,writel) block\r
 972          begin\r
 973           stTable:= new table(dicob,newdicob,egalel,readel,supel,\r
 974           extraction,writel);(* on definit les operations \85 utiliser *)\r
 975           call op(size); (* dans la table sur elem *)\r
 976          end;\r
 977    fi;\r
 978   if (i=2) then\r
 979    pref table(dicob,newdicob,egalel,readel,supel,compression,writel) block\r
 980          begin\r
 981           stTable:= new table(dicob,newdicob,egalel,readel,supel,\r
 982           compression,writel);(* idem *)\r
 983           call op(size);\r
 984          end;\r
 985    fi;\r
 986   if (i=3) then\r
 987    pref table(dicob,newdicob,egalel,readel,supel,division,writel) block\r
 988          begin\r
 989           stTable:= new table(dicob,newdicob,egalel,readel,supel,\r
 990           division,writel);(* idem *)\r
 991           call op(size);\r
 992          end;\r
 993    fi;\r
 994   if (i=4) then\r
 995    pref table(dicob,newdicob,egalel,readel,supel,multiplication,writel) block\r
 996          begin\r
 997           stTable:= new table(dicob,newdicob,egalel,readel,supel,\r
 998           multiplication,writel);(* idem *)\r
 999           call op(size);\r
1000          end;\r
1001    fi;\r
1002  od;\r
1003 end Htable;\r
1004 \r
1005 \r
1006                               (* 1006 *)\1a