tpu/u_shasc2.pas
{ -*- mode: fundamental -*-
ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION
TAD-DICCIONARIO (Inserta, Suprime, Miembro, Anula)
para enteros, con dispersi\'on cerrada: ya sea con
resoluci\'on lineal (redisp1) o bien con resoluci\'on
pseudo-aleatoria (redisp2) de las colisiones.
En el procedimiento CONJ.ALEINI se calculan todas las
constantes $d$ para un dado $B$ (potencia de 2), a partir
de los $k$ admisibles ya tabulados, los cuales fueron
hallados previamente por el programa ``ALEANUM1''.
keywords: conjunto
FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: u_shasc2.pas 2003/06/30 15:57 mstorti Exp jdelia $ }
unit u_shasc2 ;
interface
const
B = 8 ;
vacio = -1 ;
suprimido = -2 ;
nada = ' ';
type
entero = longint ;
tipo_elemento = entero ;
sethasci = object
private
A : array [0..B-1] of tipo_elemento;
D : array [0..B-1] of entero ;
procedure ERROR (s: string);
procedure ECO (k: entero);
function POT (x: entero; n: entero): entero ;
function H_FUN (x: tipo_elemento): entero;
function REDISP1 (h, i: entero): entero;
function REDISP2 (h, i: entero): entero;
function LOCALIZA (x: tipo_elemento): entero;
function LOCALIZA1 (x: tipo_elemento): entero;
public
procedure ANULA;
procedure ALEINI;
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
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.POT (x: entero; n: entero): entero ;
var
i, p : entero ;
begin
p := 1 ;
for i := 1 to (n) do p := p * x ;
POT := p
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ERROR (s: string);
begin
write ('error: ');
writeln (s);
halt
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ECO (k: entero);
var
j, l : entero ;
begin
writeln ;
writeln (' base ; B = ', B : 8);
writeln (' k (B) pre_definida ; k_B = ', k : 8) ;
writeln ;
writeln (' constantes d_i (B,k) calculadas: ');
l := -1 ;
for j := 0 to (B-1) do begin
l := l + 1 ;
if (l > 4) then begin
writeln ;
l := 0
end ; {if}
write (nada, D [j]:14)
end ;
writeln
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ALEINI;
const
pmax = 20 ;
deba = 0 ;
k : array [1..pmax] of {1ra cte k hallada para cada B}
entero = ( 1, {2** 1 = 2}
3, {2** 2 = 4}
3, {2** 3 = 8}
3, {2** 4 = 16}
5, {2** 5 = 32}
3, {2** 6 = 64}
3, {2** 7 = 128}
29, {2** 8 = 256}
17, {2** 9 = 512}
9, {2**10 = 1024}
5, {2**11 = 2048}
83, {2**12 = 4096}
27, {2**13 = 8192}
43, {2**14 = 16384}
3, {2**15 = 32768}
45, {2**16 = 65536}
9, {2**17 = 131072}
39, {2**18 = 262144}
39, {2**19 = 524288}
9 {2**20 = 1048576}
);
var
i, n, p, t : entero;
begin
{primero determina que potencia "p" de B es 2 }
p := trunc ( ln (B) / ln (2) ) ;
n := pot (2,p);
if (n <> B) then ERROR (' B no es potencia de 2');
if (p > pmax) then ERROR (' p > pmax ');
{identifica la posicion en el vector "k" para de k (B) }
D [0] := 0 ; {para cuando no re-dispersa}
D [1] := 1 ; {semilla para los d_i a calcular}
for i := 2 to (B - 1) do begin {receta de cocina}
t := 2 * D [i - 1] ;
if ( t < B ) then
D [i] := t
else begin
D [i] := (t - B) xor k [p]
end ; {if}
end ; {i}
if (deba = 1) then ECO (k [p])
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.H_FUN (x: tipo_elemento): entero;
begin
H_FUN := x mod B
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.REDISP1 (h, i: entero): entero;
begin {re-dispersion lineal}
REDISP1 := (h + i) mod B
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.REDISP2 (h, i: entero): entero;
begin {re-dispersion pseudo-aleatoria}
REDISP2 := ( h + D [i] ) mod B
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ANULA;
var
j : entero;
begin
for j := 0 to (B - 1) do A [j] := vacio
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA (x: tipo_elemento): entero;
var
inicial, i, j: entero;
begin
inicial := H_FUN (x);
i := 0;
j := REDISP2 (inicial, i);
while (i < B) and (A [j] <> x) and
(A [j] <> vacio) do begin
i := i + 1 ;
j := REDISP2 (inicial,i)
end ;
LOCALIZA := j
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA1 (x: tipo_elemento): entero;
var
ini, i, j: entero;
begin
ini := H_FUN (x);
i := 0;
j := REDISP2 (ini, i);
while (i < B) and (A [j] <> x) and
(A [j] <> vacio) and
(A [j] <> suprimido) do begin
i := i + 1 ;
j := REDISP2 (ini,i)
end ;
LOCALIZA1 := j
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.INSERTA (x: tipo_elemento);
var
cubeta : entero;
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 fallo: 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 : entero;
begin
cubeta := LOCALIZA (x);
if ( A [cubeta] = x) then A [cubeta] := suprimido
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.IMPRIME (s: string);
var
j : entero;
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 : entero;
begin
if (length (s) > 0) then writeln (s);
for j := 0 to (B-1) do write (j,' ', A [j],' ');
writeln
end ;
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
Generated by GNU enscript 1.6.1.