tpu/u_shasc2.pas
{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION
Conjunto de enteros con dispersi\'on cerrada: ya sea con
resoluci\'on lineal (redisp1) o bien con resoluci\'on
pseudo-aleatoria (redisp2), de las posibles 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,v 1.1 2002/04/25 15:57:09 mstorti Exp mstorti $}
unit u_shasc2 ;
interface
const
B = 8 ;
vacio = -1 ;
suprimido = -2 ;
nada = ' ' ;
eco = true ;
type
tipo_elemento = longint;
sethasci = object
private
A : array [0..B-1] of tipo_elemento;
D : array [0..B-1] of longint ;
procedure ERROR (s : string);
function H_FUN (x : tipo_elemento): longint;
function REDISP1 (h, i : longint): longint;
function REDISP2 (h, i : longint): longint;
function LOCALIZA (x : tipo_elemento): longint;
function LOCALIZA1 (x : tipo_elemento): longint;
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
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ERROR (s: string);
begin
write ('error: ');
writeln (s);
halt;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.H_FUN (x: tipo_elemento): longint;
begin
H_FUN := x mod B;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.REDISP1 (h, i: longint): longint;
begin {re-dispersion lineal}
REDISP1 := (h + i) mod B;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.REDISP2 (h, i: longint): longint;
begin {re-dispersion pseudo-aleatoria}
REDISP2 := ( h + D [i] ) mod B;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ANULA;
var
j : longint;
begin
for j := 0 to (B - 1) do A [j] := vacio;
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.ALEINI;
const
pmax = 20 ;
k : array [1..pmax] of {1ra cte k hallada para cada B}
longint = ( 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, j, l, p, q, t : longint;
begin
{primero verifica que B sea una potencia de 2 }
q := B ;
while ( q mod 2 = 0 ) and (q > 2) do begin
writeln ('q = ',q);
q := q div 2 ;
end ; {while}
writeln ('q = ',q);
if (q <> 2) or (q < 2) then ERROR (' B no es potencia de 2');
{identifica la posicion en el vector "k" para de k (B) }
p := trunc ( ln (B) / ln (2) ) ;
if ( p < 1 ) then ERROR (' p < 1 ');
if ( p > pmax ) then ERROR (' p > pmax ');
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
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 (eco) then begin
writeln ;
writeln (' base ; B = ', B : 8);
writeln (' k (B) pre_definida ; k_B = ', k [p] : 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 ; {j}
writeln ;
end ; {if}
end ;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA (x: tipo_elemento): longint;
var
inicial, i, j: longint;
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 ; {while}
LOCALIZA := j;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function sethasci.LOCALIZA1 (x: tipo_elemento): longint;
var
inicial, i, j: longint;
begin
inicial := H_FUN (x);
i := 0;
j := REDISP2 (inicial, i);
while (i < B) and (A [j] <> x) and
(A [j] <> vacio) and
(A [j] <> suprimido) do begin
i:= i+1;
j:= REDISP2 (inicial,i);
end; {while}
LOCALIZA1 := j;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.INSERTA (x: tipo_elemento);
var
cubeta : longint;
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 : longint;
begin
cubeta := LOCALIZA (x);
if ( A [cubeta] = x) then A [cubeta] := suprimido ;
end;
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure sethasci.IMPRIME (s: string);
var
j : longint;
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 : longint;
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.