{ 22/nov/2009 }
{ Testa funcao hash perfeita minima hpm usando 2 bits por entrada de g }
program hashingperfeito;
const
  MAXK           = 256;
  MAXNUMVERTICES = 100000; {--No. maximo de vertices--}
  MAXTAMG        = Trunc((MAXNUMVERTICES+3)/4); { Cada byte armazena 4 vertices }
  MAXTAMTABRANK  = Trunc((MAXNUMVERTICES+MAXK-1)/MAXK); { Teto de MAXNUMVERTICES/MAXK }
  MAXTRVALUE     = 255;
  MAXNUMARESTAS  = 100000; {--No. maximo de arestas--}
  MAXR           = 5;
  MAXTAMCHAVE    = 6;      {--No. maximo de caracteres da chave--}
  MAXNUMCHAVES   = 100000; {--No. maximo de chaves lidas--}
  NAOATRIBUIDO   = 3;

type
  TipoValorVertice    = -1..MAXNUMVERTICES;
  TipoValorAresta     = 0..MAXNUMARESTAS;
  Tipor               = 0..MAXR;
  TipoPesos           = array [1..MAXTAMCHAVE] of integer;
  TipoTodosPesos      = array [Tipor] of Tipopesos;
  Tipog               = array[0..MAXTAMG] of byte;
  TipoTr              = array[0..MAXTRVALUE] of byte;
  TipoTabRank         = array[0..MAXTAMTABRANK] of Integer;
  TipoK               = 4..MAXK;  
  TipoChave           = packed array[1..MAXTAMCHAVE] of char;
  TipoConjChaves      = array[0..MAXNUMCHAVES] of TipoChave;
  TipoArranjoVertices = array[Tipor] of TipoValorVertice;
  TipoIndice          = 0..MAXNUMVERTICES;

var
  M         : TipoValorVertice;
  N         : TipoValorAresta;
  r         : Tipor;
  g         : Tipog;
  Tr        : TipoTr;
  TabRank   : TipoTabRank;
  TamTabRank: Integer;
  k         : TipoK;
  Valorg    : byte;
  Pesos     : TipoTodosPesos; 
  i, j      : integer;
  ConjChaves: TipoConjChaves;
  NomeArq   : string [100];
  Chave     : TipoChave;
  ArqChaves : text;
  ArqFHP    : text;

Procedure GeraTr (var Tr: TipoTr);
var i, j, v, Soma: Integer;
begin
  Soma := 0;
  for i := 0 to MAXTRVALUE do
    begin
    Soma := 0;
    v := i;
    for j := 1 to 4 do
      begin
      if ((v and 3) <> NAOATRIBUIDO) then Soma := Soma + 1;
      v := v shr 2; 
      end;
    Tr[i] := Soma;
    end;
end; { GeraTr }

Procedure ImprimeTr (var Tr: TipoTr);
var i: Integer;
begin
  write ('Tr = {');
  for i := 0 to MAXTRVALUE do
    begin
    if (i mod 16 = 0) then writeln;
    write (Tr[i], ' ');
    end;
  writeln;
  writeln ('}');
end; {ImprimeTr }

Procedure ImprimeTabRank (var TabRank    : TipoTabRank;
                          var TamTabRank : Integer);
var i: Integer;
begin
  write ('TabRank = {');
  for i := 0 to TamTabRank - 1 do
    begin
    if (i mod 16 = 0) then writeln;
    write (TabRank[i], ' ');
    end;
  writeln;
  writeln ('}');
end;

{-- Funcao hash universal apresentada no Programa 5.22 --}
function h (Chave: TipoChave; p: TipoPesos): TipoIndice;
var
  i, Soma: integer;
begin
  Soma := 0;
  for i := 1 to MAXTAMCHAVE do 
    Soma := Soma + ord(Chave[i]) * p[i];
  h := Soma mod M;
end; { h }

procedure AtribuiValor2Bits (var g: Tipog; 
                             indice: Integer;
                             valor: byte);
var i, pos: Integer;
begin
  i   := indice div 4;
  pos := (indice mod 4);
  pos := pos * 2; {Cada valor ocupa 2 bits}
  g[i] := g[i] and (not(3 shl pos));  { primeiro zeramos os dois bits a serem atribuidos. }
  g[i] := g[i] or (valor shl pos);    { agora a atribuicao e realizada. } 
end; {AtribuiValor2Bits}

function ObtemValor2Bits (var g : Tipog; 
                          indice: Integer): byte;
var i, pos: Integer;
begin
  i   := indice div 4;
  pos := (indice mod 4);
  pos := pos * 2; {Cada valor ocupa 2 bits}
  ObtemValor2Bits := (g[i] shr pos) and 3;  
end; {ObtemValor2Bits}

function hp (Chave    : TipoChave; 
             r        : Tipor;
             var Pesos: TipoTodosPesos;
             var g    : Tipog): TipoIndice;
var i, v: integer;  a: TipoArranjoVertices;
begin
v := 0;
for i := 0 to r - 1 do
  begin
  a[i] := h (Chave, Pesos[i]);
  v := v + ObtemValor2Bits (g, a[i]);
  end;
  v := v mod r;
  hp := a[v];
end; { hp }

function hpm (Chave      : TipoChave; 
              r          : Tipor;
              var Pesos  : TipoTodosPesos;
              var g      : Tipog;
              var Tr     : TipoTr;
              k          : TipoK;
              var TabRank: TipoTabRank): TipoIndice;
var i, j, u, Rank, Byteg: TipoIndice;
begin
  u := hp (Chave, r, Pesos, g);
  j := u div k;      Rank := TabRank[j];
  i := j * k;        j := i;
  Byteg := j div 4;  j := j + 4;
  while (j < u) do
    begin
    Rank := Rank + Tr[g[Byteg]];
    j := j + 4;  Byteg := Byteg + 1;
    end;
  j := j - 4;
  while (j < u) do
    begin
    if (ObtemValor2Bits (g, j) <> NAOATRIBUIDO) then Rank := Rank + 1;
    j := j + 1;
    end;
  hpm := Rank;
end; { hpm }

function VerificaFHP: Boolean;
var TabelaHash: array[0 .. MAXNUMVERTICES - 1] of Boolean;
    i, indiceFHP: Integer;
begin
  VerificaFHP := true;
  for i := 0 to M - 1 do TabelaHash[i] := false;
  for i := 0 to N - 1 do 
    begin
    indiceFHP := hp (ConjChaves[i], r, Pesos, g);
    if TabelaHash[indiceFHP] then VerificaFHP := false;
    TabelaHash[indiceFHP] := true;
    end;
end;

function VerificaFHPM: Boolean;
var TabelaHash: array[0 .. MAXNUMVERTICES - 1] of Boolean;
    i, indiceFHPM: Integer;
begin
  VerificaFHPM := true;
  for i := 0 to N - 1 do TabelaHash[i] := false;
  for i := 0 to N - 1 do 
    begin
    indiceFHPM := hpm (ConjChaves[i], r, Pesos, g, Tr, k, TabRank);
    if (TabelaHash[indiceFHPM]) or (indiceFHPM >= N) then VerificaFHPM := false;
    TabelaHash[indiceFHPM] := true;
    end;
end;

begin
  write ('Nome do arquivo com chaves a serem lidas: ');
  readln (NomeArq);
  assign (ArqChaves, NomeArq);
  reset (ArqChaves);
  readln (ArqChaves, N, M, r);
  while (i < N) and (not eof(ArqChaves)) do
    begin
    readln (ArqChaves, ConjChaves[i]);
    i := i + 1;
    end;
  if (i <> N)
  then begin
       writeln ('Erro: arquivo de entrada possui menos que ', 
                N, ' elementos.');
       exit;
       end;

  write ('Nome do arquivo com a funcao hash perfeita: ');
  readln (NomeArq);
  assign (ArqFHP, NomeArq);
  reset (ArqFHP);
  readln (ArqFHP, N);
  readln (ArqFHP, M);
  readln (ArqFHP, r);
  readln (ArqFHP, k);
  GeraTr (Tr);
  ImprimeTr (Tr);
  TamTabRank := (M + k - 1) div k;
  for j := 0 to r - 1 do
    begin
    for i := 1 to MAXTAMCHAVE do read (ArqFHP, Pesos[j][i]); 
    readln (ArqFHP);
    end; 
  for i := 0 to M-1 do 
    begin
    read (ArqFHP, Valorg); 
    AtribuiValor2Bits (g, i, Valorg);
    end;
  readln (ArqFHP);
  for i := 0 to TamTabRank-1 do read (ArqFHP, TabRank[i]); 
  readln (ArqFHP);
  ImprimeTabRank (TabRank, TamTabRank);
  if (VerificaFHP())
  then writeln ('FHP foi gerada com sucesso')
  else writeln ('FHP nao foi gerada corretamente');  
  if (VerificaFHPM())
  then writeln ('FHPM foi gerada com sucesso')
  else writeln ('FHPM nao foi gerada corretamente');  
  readln (Chave);
  while Chave <> 'aaaaaa' do 
    begin
    writeln ('FHP : ', hp (Chave, r, Pesos, g));
    writeln ('FHPM: ', hpm (Chave, r, Pesos, g, Tr, k, TabRank));
    readln (Chave);
    end;
  close (ArqFHP);
end. { hashingperfeito }