program Patricia;

const D = 8; { depende de TipoChave }
type TipoChave    = char; { a definir, dependendo da aplicacao }
     TipoIndexAmp = 0..D;
     TipoDib      = 0..1;
     TipoNo       = (Interno, Externo);
     TipoArvore   = ^TipoPatNo;
     TipoPatNo    = record
                      case nt: TipoNo of
                       Interno:(Index:TipoIndexAmp; Esq,Dir:TipoArvore);
                       Externo:(Chave:TipoChave);
                    end;

function Bit (i: TipoIndexAmp; k: TipoChave): TipoDib;
{ Retorna o i-esimo bit da chave k a partir da esquerda }
var
  c, j: integer;
begin
  if i = 0
  then Bit := 0
  else begin
       c := ord (k);
       for j := 1 to D - i do c := c div 2;
       Bit := c mod 2;
       end;
end; { Bit }

function EExterno (p: TipoArvore): boolean;
{ Verifica se p^ e nodo externo }
begin
  EExterno := p^.nt = Externo;
end; { EExterno }

function CriaNodoInt (i: integer; var Esq, Dir: TipoArvore): TipoArvore;
var p: TipoArvore;
begin
  new (p, Interno); 
  p^.nt := Interno;
  p^.Esq := Esq; p^.Dir := Dir;
  p^.Index := i; CriaNodoInt := p;
end; { CriaNodoInt }

function CriaNodoExt (k: TipoChave): TipoArvore;
var p: TipoArvore;
begin
  new (p, Externo); 
  p^.nt := Externo;
  p^.Chave := k; 
  CriaNodoExt := p;
end; { CriaNodoExt }

procedure Pesquisa (k: TipoChave; t: TipoArvore);
begin
  if EExterno (t)
  then if k = t^.Chave
       then writeln ('Elemento encontrado')
       else writeln ('Elemento nao encontrado')
  else if Bit (t^.Index, k) = 0
       then Pesquisa (k, t^.Esq)
  else Pesquisa (k, t^.Dir)
end; { Pesquisa } 

function Insere (k: TipoChave; var t: TipoArvore): TipoArvore;
var p: TipoArvore; i: integer;
  function InsereEntre (k: TipoChave; var t: TipoArvore; 
                        i: integer): TipoArvore;
  var p: TipoArvore;
  begin
    if EExterno (t) or (i < t^.Index)
    then begin { cria um novo no externo }
         p := CriaNodoExt (k);
         if Bit (i, k) = 1
         then InsereEntre := CriaNodoInt (i, t, p)
         else InsereEntre := CriaNodoInt (i, p, t);
         end
    else begin
         if Bit (t^.Index, k) = 1
         then t^.Dir := InsereEntre (k, t^.Dir, i)
         else t^.Esq := InsereEntre (k, t^.Esq, i);
         InsereEntre := t;
         end;
  end; { InsereEntre }

begin  
  if t = nil
  then Insere := CriaNodoExt (k)
  else begin
       p := t;
       while not EExterno (p) do
         begin
         if Bit (p^.Index, k) = 1 then p := p^.Dir else p := p^.Esq; 
	 end;
       i := 1; { acha o primeiro bit diferente }
       while (i <= D) and (Bit (i, k) = Bit (i, p^.Chave)) do i := i+1;
       if i > D
       then begin
            writeln ('Erro: chave ja esta na arvore'); Insere := t;
            end
       else Insere := InsereEntre (k, t, i);
  end;
end; { Insere }

var a: TipoArvore;
    c: TipoChave;
    i, j, k, n, min, max: integer;
    vetor: array [32..126] of integer;

begin
  { Gera uma permutacao aleatoria de chaves dos caracteres ASCII 32 a  126 }
  min := 32;
  max := 126;
  randomize;
  for i := min to max do vetor[i] := i;
  for i := min to max do
    begin
    k := min + random (max - min);
    j := min + random (max - min);
    n := vetor[k];
    vetor[k] := vetor[j];
    vetor[j] := n;
    end;
  
  { Insere cada chave na arvore }
  for i := min to max do
    begin
    c := char (vetor[i]);
    writeln ('Inserindo chave: ', c);
    a := Insere (c, a);
    end;
  
  { Gera outra permutacao aleatoria de chaves }
  for i := min to max do
    begin
    k := min + random (max - min);
    j := min + random (max - min);
    n := vetor[k];
    vetor[k] := vetor[j];
    vetor[j] := n;
    end;

  { Pesquisa cada chave na arvore }
  for i := min to max do
    begin
    c := char (vetor[i]);
    writeln ('Pesquisando chave: ', c);
    Pesquisa (c, a);
    end;

end. { patricia }