tpu/u_shasci.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

 TAD-DICCIONARIO (Inserta, Suprime, Miembro, Anula)
 con dispersi\'on cerrada y resoluci\'on lineal de
 colisiones, para enteros.
 keywords: conjunto, tabla de dispersion

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_shasci.pas 2002/04/25 15:57 mstorti Exp mstorti  $ }
unit u_shasci;
interface
const
 B          =  8;
 vacio      = -1;
 suprimido  = -2;
type
 tipo_elemento = integer;

 sethasci = object
 private
   A : array [0..B-1] of tipo_elemento;
   procedure ERROR (s: string);
   function H_FUN  (x: tipo_elemento) : integer;
   function REDISP (h, i: integer): integer;
   function LOCALIZA  (x: tipo_elemento): integer;
   function LOCALIZA1 (x: tipo_elemento): integer;
 public
   procedure ANULA;
   procedure INSERTA (x: tipo_elemento);
   function  MIEMBRO (x: tipo_elemento): boolean;
   procedure SUPRIME (x: tipo_elemento);
   procedure IMPRIME (s: string);
   procedure IMPRIME_TODO (s :string);
 end;

implementation

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ERROR (s: string);
begin
  write ('error: ');
  writeln (s);
  halt
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.H_FUN (x: tipo_elemento): integer;
begin
  H_FUN := x mod B
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.REDISP (h, i : integer): integer;
begin
  REDISP := (h + i) mod B {redispersion lineal}
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ANULA;
var
  j : integer;
begin
  for j := 0 to (B - 1) do A [j] := vacio
end ; { ANULA }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA (x: tipo_elemento): integer;
var
  ini, i, j: integer;
begin
  ini := H_FUN (x);
  i := 0 ;
  j := REDISP (ini, i);
  while (i < B) and (A[j] <> x) and (A[j] <> vacio) do begin
    i := i + 1 ;
    j := REDISP (ini, i)
  end ; {while}
  LOCALIZA := j
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA1 (x: tipo_elemento): integer;
var
  inicial, i, j: integer;
begin
  inicial := H_FUN (x);
  i := 0 ;
  j := REDISP (inicial, i);
  while (i < B)
    and (A [j] <> x)
    and (A [j] <> vacio)
    and (A [j] <> suprimido) do begin
       i := i + 1;
       j := REDISP (inicial, i)
  end ; {while}
  LOCALIZA1 := j
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.INSERTA (x: tipo_elemento);
var
  cubeta : integer;
begin
  if ( A [LOCALIZA (x)] = x) then exit;
  cubeta := LOCALIZA1 (x);
  if (A [cubeta] = vacio) or (A[cubeta] = suprimido) then
      A [cubeta] := x
  else begin
     ERROR ('INSERTA falla por tabla llena')
  end {if}
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.MIEMBRO (x: tipo_elemento): boolean;
begin
  MIEMBRO := ( A [ LOCALIZA (x) ] = x )
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.SUPRIME (x: tipo_elemento);
var
  cubeta : integer;
begin
  cubeta := LOCALIZA (x);
  if (A [cubeta] = x) then A [cubeta] := suprimido
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.IMPRIME (s: string);
var
  j : integer;
begin
  if length (s) > 0 then writeln (s);
  for j := 0 to (B - 1) do begin
    if ( A [j] <> vacio ) then write (A [j],' ');
  end ;
  writeln
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.IMPRIME_TODO(s :string);
var
  j : integer;
begin
  if (length (s) > 0)  then writeln (s);
  for j := 0 to (B - 1) do write (j,' ',A [j],'   ') ;
  writeln
end ;

end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}