tpu/u_shasci.pas

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

 Conjunto de enteros con dispersi\'on cerrada, con
 resoluci\'on lineal de colisiones.
 keywords: conjunto, tabla de dispersion

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_shasci.pas,v 1.1 2002/04/25 15:57:09 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;  {estrategia de 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
  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) do begin
    i := i + 1;
    j := REDISP (inicial, 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 ; {for}
  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 begin
    write (j,' ',A [j],'   ');
  end ; {while}
  writeln;
end;

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