Program Htable;






(***************************************************************************)
(*                                                                         *)
(*      Projet 1 li1 par PAUL olivier et FERNANDEZ raphael                 *)
(*                GESTION D'UNE TABLE DE HACHAGE                           *)
(*                        le 13-1-1994                                     *)
(*                                                                         *)
(***************************************************************************)


const enter=10,
      extrnb=8,
      theta=0.6180339885;


(***************************************************************************)
(*                                                                         *)
(*         Definition d'une classe contenant les principaux                *)
(*         Outils utilises par la suite ...                                *)
(***************************************************************************)

unit tools: class;         (* les outils *)

unit inchar:IIUWGraph function:integer;
 var i:integer;
begin
 do
  i:=inkey;
  if i<>0 then exit fi;       (* attend q'un caractere soit saisi et *)
 od;                             (* renvoie son code *)
 result:=i;
end inchar;

unit gotoxy:procedure(col,lig:integer);
var c,d,e,f:char,
 i,j :integer;
begin
 i:=lig div 10;
 j:=lig mod 10;
 c:= chr(48+i);           (* positionne le curseur *)
 d:= chr(48+j);              (* en utilisant le driver ANSI *)
 i:=col div 10;
 j:=col mod 10;
 e:= chr(48+i);
 f:= chr(48+j);
 write( chr(27), "[", c, d, ";", e, f, "H")
end gotoxy;

unit cls : procedure;
begin
 write(chr(27),"[2J");     (* efface l'ecran *)
end cls;

unit reverse:procedure;
begin
 write( chr(27),"[5m");   (* passe en mode blink *)
end reverse;

unit normal:procedure;
begin
 write( chr(27),"[0m");  (* passe en mode normal *)
end normal;

unit box : procedure(x,y,z,w:integer);
var i:integer;
begin
 call gotoxy(x,y);
 write("É");
 for i:=2 to (z-1) do write("Í") od;
 write("»");
 for i:=1 to (w-1) do
  call gotoxy(x,y+i);      (* affiche une boite au coord x,y *)
  write("º");              (* de largeur z et de hauteur w *)
  call gotoxy(x+z-1,y+i);
  write("º");
 od;
 call gotoxy(x,y+w);
 write("È");
 for i:=2 to (z-1) do write("Í") od;
 write("¼");
end box;

unit line:procedure;
var t:integer;
begin
 call gotoxy(1,23);
 for t:=1 to 79 do write("_") od;
 call gotoxy(1,24);           (* trace une ligne et positionne le curseur *)
 for t:=1 to 79 do write(" ") od;
 call gotoxy(1,24);
end line;

unit decbin:function(input e:integer):arrayof integer;
var f,g:integer;
begin
 array result dim(0:7);
 for f:=0 to 7 do result(f):=0 od;
 f:=e;
 g:=0;            (* convertisseur decimal-binaire *)
 while (f<>0) do
  result(g):=f mod 2;
  f:=f div 2;     (* on utilise les restes de la division par 2 *)
  g:=g+1;
 od;
end decbin;

unit exp:function(x:integer):integer;
var t:integer;
begin
 result:=1;                           (* calcule 2^x *)
 for t:=1 to x do result:=result*2 od;
end exp;

unit bindec:function(input e:arrayof integer;l:integer):integer;
var i,res:integer;
begin
 i:=0;
 result:=0;
 while (i<l) do
  result:=result+exp(i)*e(i); (* conversion binaire-decimal *)
  i:=i+1;
 od;
end bindec;

unit delay:procedure;
begin
 call line;            (* attend qu 'une touche soit pressee *)
 write("Appuyez sur une touche pour la suite");
 while inchar=0 do od;
end delay;

end tools;


(***************************************************************************)
(*                                                                         *)
(*         Definition des elements et des operations s'y rapportant        *)
(*                                                                         *)
(***************************************************************************)

unit dicob : class; (* le type d 'element saisi *)
var mot :arrayof char, (* un mot de 25 lettres max *)
   trad :arrayof char; (* sa traduction en anglais *)
begin
 array mot dim (1:25);
 array trad dim (1:100);
end dicob;

unit newdicob : function : dicob; (* cree un nouvel element *)
var t:integer;
begin
 result:=new dicob;
 for t:=1 to 100 do result.trad(t):=' ' od; (* et l 'initialise *)
 for t:=1 to 25 do result.mot(t):=' ' od;
end newdicob;

unit readel : tools function(f:file) : dicob;
var t:integer,         (* lit un element *)
    c:char,
 tamp:dicob;
begin
 if (f=NONE) then
  call line;
  write("saisissez votre mot puis <enter> pour valider");
  call box(1,15,79,2);      (* si l' element provient du clavier *)
  call gotoxy(2,16);        (* on agremente la presentation *)
  write("mot : ");
 fi;
 t:=1;
 if (f<>NONE) then read(f,c) else read(c) fi;
 if (ord(c)=enter) then read(c) fi;
 tamp:=newdicob;
 if (f<>NONE) then              (* saisie du nom *)
  while ((t<24) and not(eoln(f)))
   do
    tamp.mot(t):=c;              (* si l' element provient d'un fichier *)
    read(f,c);
    t:=t+1;
   od;
 else
  while ((t<24) and (ord(c)<>enter))
   do
    tamp.mot(t):=c;
    read(c);            (* si l' element provient du clavier *)
    t:=t+1;
   od;
  if (t=24) then readln fi;
 fi;
 tamp.mot(t):=c;
 tamp.mot(t+1):=chr(enter); (* on en marque la fin par enter *)
 if (f<>NONE) then readln(f) fi;
 if (f=NONE) then
  call cls;
  call line;
  write("saisissez votre mot puis <enter> pour valider");
  call box(1,15,79,3);           (* si l' element provient du clavier *)
  call gotoxy(2,16);
  write("traduction : ");
 fi;
 t:=1;
 if (f<>NONE) then read(f,c) else read(c) fi;
 if (f<>NONE) then              (* saisie de la traduction *)
  while ((t<100) and not(eoln(f)))
   do
    tamp.trad(t):=c;
    read(f,c);                  (* si l' element provient d'un fichier *)
    t:=t+1;
   od;
 else
  while ((t<100) and (ord(c)<>enter))
   do
    tamp.trad(t):=c;
    read(c);                     (* si l' element provient du clavier *)
    t:=t+1;
   od;
 fi;
 tamp.trad(t):=c;
 tamp.trad(t+1):=chr(enter);     (* on en marque la fin par enter *)
 if (f<>NONE) then readln(f) fi;
 result:=tamp;
end readel;

unit writel : tools procedure(e:dicob);(* ecriture de l 'element *)
var t:integer;
begin
 t:=1;
 call box(1,15,79,3);
 call gotoxy(2,16);
 while ((ord(e.mot(t))<>enter) and (t<=25))
  do
    write(e.mot(t));         (* ecriture du mot *)
    t:=t+1;
  od;
 write(" se traduit par ");
 t:=1;
 while ((ord(e.trad(t))<>enter) and (t<=25))
  do
    write(e.trad(t));       (* et de la traduction *)
    t:=t+1;
  od;
end writel;

unit supel :function(e1:dicob,e2:dicob):boolean;
var t:integer,
  res:integer;
begin                       (* cherche si e1>e2 *)
 res:=0; (* res=0 si e1=e2 ,res=-1 si e2>e1,res=1 si e1>e2 *)
 t:=1;
 while ((t<25) and (res=0) and (ord(e1.mot(t))<>enter)
 and (ord(e2.mot(t))<>enter))
  do
   if (ord(e1.mot(t))<ord(e2.mot(t))) then res:=-1 fi;
   if (ord(e1.mot(t))>ord(e2.mot(t))) then res:=1 fi;
   t:=t+1;
  od;
 if (ord(e1.mot(t))=enter) and (ord(e2.mot(t))<>enter) and (res=0)
  then res:=-1 fi; (* le plus long est le plus grand *)
 if (ord(e2.mot(t))=enter) and (ord(e1.mot(t))<>enter) and (res=0)
  then res:=1 fi;   (* idem *)
 result:=(res=1);
end supel;

unit egalel :function(input e1,e2:dicob):boolean;
var t:integer, (* cherche si deux elements sont egaux *)
  res:integer;
begin
 res:=0;
 t:=1;
 while ((t<25) and (res=0) and (ord(e1.mot(t))<>enter)
 and (ord(e2.mot(t))<>enter))
  do
   if (e1.mot(t)<>e2.mot(t)) then res:=1 fi;
   t:=t+1;
  od;
 if (ord(e1.mot(t))<>ord(e2.mot(t))) then res:=1 fi;
 result:=(res=0);
end egalel;

unit extraction : tools function(e1:dicob;long:integer):integer;
var t:integer,      (* function de hachage par extraction *)
    tamp:arrayof integer,
    rep:arrayof arrayof integer;
begin
 array tamp dim(0:31);
 for t:=0 to 31 do tamp(t):=0 od;
 array rep dim(1:extrnb);
 for t:=1 to extrnb do rep(t):=decbin(ord(e1.mot(t))) od;(* conversion *)
 for t:=1 to extrnb do tamp(t-1):=rep(t)(t-1) od;(*on prend les extrnb*)
 result:=((bindec(tamp,32) mod long)+1);(* premiers bits *)
 (* voir remarque fonction suivante pour mod *)
 kill(tamp);
 for t:=1 to extrnb do kill(rep(t)) od;
end extraction;

unit compression : tools function(e1:dicob;long:integer):integer;
var t,l,nb0,nb1,u:integer, (* function de hachage par compression *)
    tamp:arrayof integer,
    rep:arrayof arrayof integer;
begin
 array tamp dim(0:7);
 for t:=0 to 7 do tamp(t):=0 od;
 l:=1;
 while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;
 l:=l-1; (* longueur du mot *)
 array rep dim(1:l+1);
 for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od;
 for u:=0 to 7 do
  nb0:=0;nb1:=0;
  for t:=1 to l do
   if (rep(t)(u)=0) then nb0:=nb0+1 fi;  (* on calcule le nombre de 1 et *)
   if (rep(t)(u)=1) then nb1:=nb1+1 fi;  (* de 0 pour chaque bit *)
  od;
  if ((nb1 mod 2)=1) then tamp(u):=1   (* Xor *)
  else tamp(u):=0 fi;
 od;
 result:=((bindec(tamp,8) mod long)+1);(* reconversion*)
 kill(tamp);
 for t:=1 to l do kill(rep(t)) od;
end compression;(*le mod permet de prendre une longueur de tableau variable*)
                     (* au detriment de la "precision" de la fonction *)

unit division : tools function(e1:dicob;long:integer):integer;
var t,l,u,v:integer,      (* function de hachage par division *)
    tamp:arrayof integer,
    rep:arrayof arrayof integer;
begin
 l:=1;
 while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;
 l:=l-1;
 array rep dim(1:l+1);
 array tamp dim(0:8*(l));
 for t:=0 to 8*l-1 do tamp(t):=0 od;
 for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od; (* conversion *)
 u:=1;
 v:=0;
 for t:=0 to 8*l-1 do
  tamp(t):=rep(u)(v);
  v:=v+1;
  if (v=8) then      (* on recopie les conversions dans un seul tableau *)
   v:=0;
   u:=u+1;
  fi;
 od;
 result:=(bindec(tamp,8*l) mod long)+1; (* que l 'on convertit *)
 kill(tamp);
 for t:=1 to l+1 do kill(rep(t)) od;
end division;

unit multiplication : tools function(e1:dicob;long:integer):integer;
var pos:real,  (* function de hachage par multiplication *)
    t,l,u,v:integer,
    tamp:arrayof integer,
    rep:arrayof arrayof integer;
begin
 l:=1;
 while ((ord(e1.mot(l))<>enter) and (l<25)) do l:=l+1 od;
 l:=l-1;
 array rep dim(1:l+1);
 array tamp dim(0:8*(l));
 for t:=0 to 8*l-1 do tamp(t):=0 od;
 for t:=1 to l do rep(t):=decbin(ord(e1.mot(t))) od;
 u:=1;
 v:=0;                        (* idem division *)
 for t:=0 to 8*l-1 do
  tamp(t):=rep(u)(v);
  v:=v+1;
  if (v=8) then
   v:=0;
   u:=u+1;
  fi;
 od;
 pos:=bindec(tamp,8*l)*theta; (* conversion *)
 result:=(entier((pos-entier(pos))*long)+1);
 kill(tamp);
 for t:=1 to l+1 do kill(rep(t)) od;
end multiplication;

(***************************************************************************)
(*                                                                         *)
(*         Definition de la classe table ainsi que des operations          *)
(*         utilisees par celle-ci ...                                      *)
(***************************************************************************)

unit table : tools class (type elem;function newelem:elem;
function egalelem(e1,e2:elem):boolean;function readelem(f:file):elem;
function supelem(e1,e2:elem):boolean;
function hachelem(e1:elem;l:integer):integer;procedure writelem(e:elem));

unit tree: class (el: elem); (* definition d 'un arbre binaire de recherche *)
 var left,right: tree;
end tree;

unit max:function (input t:tree):tree;
var tamp:tree,
   continue:boolean;
begin
 continue:=TRUE;
 if (t=NONE) then
  continue:=FALSE;
  tamp:=NONE;      (* calcule le plus grand element d 'un arbre *)
 else
  tamp:=t;
  while continue
  do
     if (tamp.right<>NONE) then
      tamp:=tamp.right;     (* celui-ci se trouve en bas a droite *)
     else continue:=FALSE;
     fi;
  od;
 fi;
 result:=tamp;
 call line;
 writeln("maximum trouve ... fait.");
end max;

unit find:function(input t:tree;e:elem):tree;
var tamp: tree,
 continue,ok :boolean; (* recherche d 'un elemnt *)
begin
 continue:=TRUE;
 if (t=NONE) then
  tamp:=NONE;
  ok:=FALSE;
 else
  tamp:=t;
  ok:=FALSE;
  while continue
  do
    if supelem(e,tamp.el) then
     if (tamp.right<>NONE) then
      tamp:=tamp.right; (* si l'arbre courant est plus petit on va a droite *)
     else continue:=FALSE;
     fi;
    else
     if egalelem(e,tamp.el) then
      continue:=FALSE; (* si l'arbre courant est celui recherche on arrete *)
      ok:=TRUE;
     else
      if (tamp.left<>NONE) then
        tamp:=tamp.left; (* sinon on va a gauche *)
      else continue:=FALSE;
      fi;
     fi;
    fi;
  od;
 fi;
 call line;
 writeln("element trouve ... fait.");
 if ok then result:=tamp;
 else result:=NONE fi;
end find;

unit add: function (input t: tree; e: elem):tree;
 var tamp1,tamp2: tree,
 continue :boolean; (* ajout d 'un element a un arbre *)
begin
 continue:=TRUE;
 if (t=NONE) then
  t:=new tree(e);
  continue:=FALSE;
 else
  tamp1:=t;
  while continue
  do
    if supelem(e,tamp1.el) then
     if (tamp1.right<>NONE) then
      tamp1:=tamp1.right; (* idem recherche *)
     else continue:=FALSE fi;
    else
     if (tamp1.left<>NONE) then
      tamp1:=tamp1.left;
     else continue:=FALSE fi;
    fi;
  od;
  tamp2:=new tree(e);(* on cree un nouvel arbre *)
  tamp2.left:=NONE;
  tamp2.right:=NONE;
  if supelem(e,tamp1.el) then tamp1.right:=tamp2;
  else tamp1.left:=tamp2 fi;(*on le place*)
  call line;
  writeln("ajout classique ... fait.");
 fi;
 result:=t;
end add;

unit last:function(input t:tree;input e:tree;output r:boolean):tree;
var tamp: tree, (* recherche l'element precedent un autre *)
 continue,ok :boolean;
begin
 continue:=TRUE;
 ok:=FALSE;
 if (t=NONE) then
  ok:=FALSE;
 else
  tamp:=t;
  while continue
   do
     if (tamp.right<>NONE) then
      if egalelem(e.el,tamp.right.el) then
       continue:=FALSE;
       ok:=TRUE; (* idem recherche mais avec 2 possibilites *)
       r:=TRUE;
      fi;
     fi;
     if (tamp.left<>NONE) then
      if egalelem(e.el,tamp.left.el) then
       continue:=FALSE;
       ok:=TRUE;
       r:=FALSE;
      fi;
     fi;
     if not(ok) then
      if supelem(e.el,tamp.el) then
       if (tamp.right<>NONE) then
        tamp:=tamp.right;
       else continue:=FALSE;          (* deplacement *)
       fi;
      else
       if (tamp.left<>NONE) then
         tamp:=tamp.left;
       else continue:=FALSE;
       fi;
      fi;
     fi;
   od;
 fi;
 call line;
 writeln("element precedent trouve ... fait.");
 if ok then result:=tamp;
 else result:=NONE fi;
end last;

unit sub: function (input t: tree;e:elem):tree;
var tamp2,tamp3,pred1,pred2: tree,
    r1,r2:boolean; (* on enleve une element a un arbre *)
begin
  tamp2:=find(t,e);     (* on recherche la place de l' element *)
  pred1:=last(t,tamp2,r1);(* son pere *)
  if (tamp2<>NONE) then
   if (tamp2=t) and (tamp2.left=NONE) then
      t:=tamp2.right;
   else
    if (tamp2.left=NONE) then
     if r1 then
      pred1.right:=tamp2.right;
     else
      pred1.left:=tamp2.right;    (* on raccorde *)
     fi;
     kill(tamp2);
    else
     tamp3:=max(tamp2.left);(* on cherche le max du sous arbre gauche *)
     pred2:=last(t,tamp3,r2);(* et son pere *)
     if (tamp3<>NONE) then
      if r1 then
         if (pred1<>NONE) then pred1.right:=tamp3;
         else t:=tamp3;
         fi;
         if (pred2<>tamp2) then pred2.right:=tamp3.left fi;
         tamp3.right:=tamp2.right;
         tamp3.left:=pred2;                   (* on connecte *)
       else
         if (pred1<>NONE) then pred1.left:=tamp3;
         else t:=tamp3;
         fi;
         if (pred2<>tamp2) then pred2.right:=tamp3.left fi;
         tamp3.right:=tamp2.right;
         tamp3.left:=pred2;
      fi;
     fi;
      kill(tamp2);
    fi;
   fi;
 else
  call line;
  writeln("element non touve ...");
 fi;
 call line;
 writeln("deletion terminee ... fait.");
 result:=t;
end sub;

unit proof:function(input t:tree):integer;
begin (* calcule la profondeur d 'un arbre recursivement*)
 if t<>NONE then
   result:=imax(proof(t.left),proof(t.right))+1;
 else(* proof=max(proof(arbredroit),proof(arbregauche)) *)
  result:=0;
 fi;
end;

unit total:procedure(input t:tree;input x,y,z:integer;input current:tree);
var i:integer;(* affiche un arbre recursivement *)
begin
 if (t<>NONE) then
  if (t.right<>NONE) and (t.left=NONE) then
    call gotoxy(x,y);
    write("e");
    y:=y+1;          (* si le sous arbre droit existe on l' affiche *)
    call gotoxy(x,y);
    write("Ê");
    for i:=2 to (exp(z-2)) do write("Í") od;
    x:=x+exp(z-2);
    call total(t.right,x,y,z-1,current);
  fi;
  if (t.left<>NONE) and (t.right=NONE) then
    call gotoxy(x,y);
    write("e");
    y:=y+1;         (* si le sous arbre gauche existe on l' affiche *)
    call gotoxy(x-exp(z-2),y);
    for i:=1 to (exp(z-2)) do write("Í") od;
    write("Ê");
    x:=x-exp(z-2);
    call total(t.left,x,y,z-1,current);
  fi;
  if (t.left<>NONE) and (t.right<>NONE) then
    call gotoxy(x,y);
    write("e");
    y:=y+1;
    call gotoxy(x,y);(* si les deux existent on les affiche les deux *)
    write("Ê");
    for i:=2 to (exp(z-2)) do write("Í") od;
    x:=x+exp(z-2);
    call total(t.right,x,y,z-1,current);
    y:=y-1;
    x:=x-exp(z-2);
    call gotoxy(x,y);
    write("e");
    y:=y+1;
    call gotoxy(x-exp(z-2),y);
    for i:=1 to (exp(z-2)) do write("Í") od;
    write("Ê");
    x:=x-exp(z-2);
    call total(t.left,x,y,z-1,current);
  fi;
    call gotoxy(x,y);(* sinon on affiche l'element *)
    write("e");
 fi;
end total;

unit tableau : procedure (input e,f:integer);
begin (* on affiche le tableau correspondant au code de hachage *)
 if ((e<f) or (e=f)) and ((e>1) or (e=1)) then
     call box(30,10,10,10);
     call gotoxy(31,15); (* tableau recherche *)
     call reverse;
     write(e);
     call normal;
 fi;
 if (e+1<f) or (e+1=f) then
     call box(50,10,10,10); (* le suivant *)
     call gotoxy(51,15);
     write(e+1);
 fi;
 if (e-1>1) or (e-1=1) then
     call box(10,10,10,10); (* le precedent *)
     call gotoxy(11,15);
     write(e-1);
 fi;
end tableau;

unit newtable : function (input long : integer) :arrayof tree;
var t : integer;(* cree une nouvelle table *)
begin
 array result dim (1:long);
 for t:=1 to long do result(t):=NONE od;
 call line;
 writeln("table initialisee ... fait.");
end newtable;

unit ajoute :function(input T:arrayof tree;long:integer):arrayof tree;
var lg,pos:integer, (* ajoute un element a la table *)
     e:elem,
  current:tree;
begin
 e:=readelem(none); (* lit l'element *)
 call cls;
 pos:=hachelem(e,long);(* calcule son hach code *)
 call line;
 writeln("hach code calcule ... fait. ",pos);
 call tableau(pos,long);(* marque sa position *)
 call line;
 writeln("tableau designe ... fait.");
 current:=find(T(pos),e);(* le cherche *)
 if (current=NONE) then
  T(pos):=add(T(pos),e);(* s'il n'existe pas l'ajoute *)
  call line;
  writeln("element ajoute ... fait.");
  call cls;
  lg:=proof(T(pos)); (* calcule la profondeur de l'arbre *)
  if lg<6 then call total(T(pos),40,1,lg,current) else  (* affiche l'arbre *)
   call line;
   write("l'arbre est trop grand pour etre imprime ...");
  fi;
 else
  call cls;
  writeln("element deja stocke ...");
 fi;
  result:=T;
  call delay;(* attend que l'utilisateur ai vu l'arbre *)
end ajoute;

unit supp :function(input T:arrayof tree;long:integer):arrayof tree;
var lg,pos:integer,(* supprime un element *)
    e:elem,
    current:tree;
begin
 e:=readelem(none);     (* idem ajoute *)
 call cls;
 pos:=hachelem(e,long);
 call line;
 writeln("hach code calcule ... fait. ",pos);
 call tableau(pos,long);
 call line;
 writeln("tableau designe ... fait.");
 current:=find(T(pos),e);
 if (current<>NONE) then
   T(pos):=sub(T(pos),e);
   call line;
   writeln("element detruit ... fait.");
   call cls;
   lg:=proof(T(pos));
   if lg<6 then call total(T(pos),40,1,lg,current) else
     call line;
     write("l'arbre est trop grand pour etre imprime ...");
   fi;
  else
   call cls;
   writeln("non trouve ...");
 fi;
 call delay;
 result:=T;
end supp;

unit recherche :procedure(input T:arrayof tree;long:integer);
var pos:integer,(* recherche un element dans la table *)
  current:tree,
      e:elem;
begin
 e:=readelem(none);(* idem ajoute *)
 call cls;
 pos:=hachelem(e,long);
 call line;
 writeln("hach code calcule ... fait. ",pos);
 call tableau(pos,long);
 call line;
 writeln("tableau designe ... fait.");
 current:=find(T(pos),e);
 call cls;
 if (current<>NONE) then call writelem(current.el);(* ecrit le resultat *)
 else writeln("non trouve ...") fi;(* de la recherche *)
 call line;
 writeln("recherche terminee ... fait.");
 call delay;
end recherche;

unit demo :function(input T:arrayof tree;long:integer):arrayof tree;
var fich:file,(*stocke automatiquement des elements contenus dans un fichier*)
 c:char,
 pos,lg:integer,
 e:elem,
 current:tree;
begin
 open(fich,text,unpack("data.dem"));(* on ouvre le fichier *)
 call line;
 writeln("ouverture du fichier ... fait.");
 call reset(fich);                   (* en lecture *)
 while not(eof(fich))
  do
   e:=readelem(fich);(* idem ajoute *)
   pos:=hachelem(e,long);
   call line;
   writeln("hach code calcule ... fait. ");
   call tableau(pos,long);
   call line;
   writeln("tableau designe ... fait.");
   current:=find(T(pos),e);
   if (current=NONE) then
     T(pos):=add(T(pos),e);
     call line;
     writeln("element ajoute ... fait.");
     lg:=proof(T(pos));
     call cls;
     if lg<6 then call total(T(pos),40,1,lg,current) else
      call line;
      write("l'arbre est trop grand pour etre imprime ...");
     fi;
     call line;
     writeln("arbre imprime ... fait.");
   else
     call cls;
     writeln("element deja stocke ...");
   fi;
  od;
 result:=T;
end demo;

unit numb:function(input T:tree):integer;
begin (* calcule le nombre de sommets par arbre recursivement *)
 if (T<>NONE) then
  result:=numb(T.left)+numb(T.right);
 else (* nbsom=nbsom(arbregauche)+nbsom(arbredroit) *)
  result:=1;
 fi;
end numb;

unit stats:procedure(input T:arrayof tree;long:integer);
var u,s1,s2,s3,max1,max2:integer,
    s,v:arrayof integer;(* calcule quelques satistiques sur les donnees *)
                           (* stockees dans la table *)
begin
 s1:=0;s2:=0;s3:=0;
 array s dim(1:long);
 array v dim(1:long);
 for u:=1 to long do
   if (T(u)<>NONE) then
    s1:=s1+1;(* nombre d'arbre utilises *)
    s(u):=numb(T(u))-1;
    v(u):=proof(T(u));
    s2:=s2+s(u);(* nombre total de sommets *)
    s3:=s3+v(u);(* profondeur totale de la table *)
   fi;
 od;
 max1:=1;max2:=1;
 for u:=1 to long do
  if (s(u)>s(max1)) then max1:=u fi;
  if (v(u)>s(max2)) then max2:=u fi;
 od;
 call cls;
 call gotoxy(10,5);
 write("Nombre Total de sommets :",s2);
 call gotoxy(10,7);
 write("Nombre Total d 'arbres non vides :",s1);
 if s1<>0 then
  call gotoxy(10,9);
  write("Nombre moyen de sommet par arbre :",s2/s1);
  call gotoxy(10,15);
  write("Profondeur moyenne :",s3/s1);
 else
  call gotoxy(10,9);
  write("Tableau non rempli ...");
 fi;
 call gotoxy(10,11);
 write("Nombre de sommets de l'Arbre le plus important :",s(max1));
 call gotoxy(10,13);
 write("Profondeur de l'Arbre le plus grand :",v(max2));
 call box(7,3,70,15);
 call line;
 write("stats calculees ... fait.");
 call delay;
end stats;


unit op:procedure(size:integer);
var T:arrayof tree, (* menu *)
    c,i:integer;
begin
     T:=newtable(size);
     while (i<>6) do
      call cls;
      call line;
      write("utilisez les fleches  haut/bas pour vous deplacer, droite pour
      valider");
      call gotoxy(1,7);
      i:=1;
      c:=0;
      writeln("               Inserer un element");writeln;
      writeln("               Rechercher un element");writeln;
      writeln("               Supprimer un element");writeln;
      writeln("               Demo");writeln;
      writeln("               Statistiques");writeln;
      writeln("               Quitter");writeln;
      call box(5,4,50,17);
      call box(10,4+2*i,35,2);
      while (c<>-77) do
       c:=inchar;
        if (c=-80) or (c=-72) then
         call gotoxy(10,4+2*i);
         write("                                            ");
         call gotoxy(10,4+2*(i+1));
         write("                                            ");
         call gotoxy(10,4+2*i+1);
         write("  ");
         call gotoxy(44,4+2*i+1);
         write("  ");
         if (c=-80) then i:=i+1 fi;
         if (c=-72) then i:=i-1 fi;
         if (i=7) then i:=1 fi;
         if (i=0) then i:=6 fi;
         call box(10,4+2*i,35,2);
        fi;
        od;
        call cls;
        case i
         when 1 :T:=ajoute(T,size);
         when 2 :call recherche(T,size);
         when 3 :T:=supp(T,size);
         when 4 :T:=demo(T,size);
         when 5 :call stats(T,size);
        esac;
      od;
     writeln("operations terminees ... fait.");
end op;

end table;


(***************************************************************************)
(*                                                                         *)
(*                   PROGRAMME PRINCIPAL                                   *)
(*                                                                         *)
(***************************************************************************)

var stTable:table,
       size,algo,i:integer,
       c:integer;
begin (* prog principal *)
 i:=1;
 while (i<>5) do
  pref tools block
   begin
     call cls;
     call line;
     write("utilisez les fleches  haut/bas pour vous deplacer, droite pour
     valider");
     call gotoxy(1,7);
     writeln("               EXTRACTION");writeln;
     writeln("               COMPRESSION");writeln;
     writeln("                DIVISION");writeln;
     writeln("              MULTIPLICATION");writeln;
     writeln("                 QUITTER");writeln;
     call box(5,4,50,15);
     call box(10,4+2*i,35,2);
     while (c<>-77) do
      c:=inchar;
      if (c=-80) or (c=-72) then
       call gotoxy(10,4+2*i);
       write("                                            ");
       call gotoxy(10,4+2*(i+1));
       write("                                            ");
       call gotoxy(10,4+2*i+1);
       write("  ");
       call gotoxy(44,4+2*i+1);
       write("  ");
       if (c=-80) then i:=i+1 fi;
       if (c=-72) then i:=i-1 fi;
       if (i=6) then i:=1 fi;
       if (i=0) then i:=5 fi;
       call box(10,4+2*i,35,2);
      fi;
     od;
     call cls;
     if (i<>5) then
      call cls;
      call line;
      write("!! (petites tailles)+(beaucoup d'elts)=(pbs de memoire)");
      call box(20,15,35,2);
      call gotoxy(21,16);
      write("taille du tableau desire : ");
      read(size);
     fi;
     call cls;
     c:=0;
   end;
  if (i=1) then
   pref table(dicob,newdicob,egalel,readel,supel,extraction,writel) block
         begin
          stTable:= new table(dicob,newdicob,egalel,readel,supel,
          extraction,writel);(* on definit les operations … utiliser *)
          call op(size); (* dans la table sur elem *)
         end;
   fi;
  if (i=2) then
   pref table(dicob,newdicob,egalel,readel,supel,compression,writel) block
         begin
          stTable:= new table(dicob,newdicob,egalel,readel,supel,
          compression,writel);(* idem *)
          call op(size);
         end;
   fi;
  if (i=3) then
   pref table(dicob,newdicob,egalel,readel,supel,division,writel) block
         begin
          stTable:= new table(dicob,newdicob,egalel,readel,supel,
          division,writel);(* idem *)
          call op(size);
         end;
   fi;
  if (i=4) then
   pref table(dicob,newdicob,egalel,readel,supel,multiplication,writel) block
         begin
          stTable:= new table(dicob,newdicob,egalel,readel,supel,
          multiplication,writel);(* idem *)
          call op(size);
         end;
   fi;
 od;
end Htable;


                              (* 1006 *)