program ArvoreBinaria;

type TipoChave      = integer;
     TipoRegistro   = record
                        Chave: TipoChave;
                        { outros componentes }
                      end;
     TipoApontador  = ^TipoNo;
     TipoNo         = record
                        Reg: TipoRegistro;
                        Esq, Dir: TipoApontador;
                      end;
     TipoDicionario = TipoApontador;

procedure Pesquisa (var x: TipoRegistro; var p: TipoApontador);
begin
  if p = nil
  then writeln ('Erro: TipoRegistro nao esta presente na arvore')
  else if x.Chave < p^.Reg.Chave
       then Pesquisa (x, p^.Esq)
       else if x.Chave > p^.Reg.Chave
            then Pesquisa (x, p^.Dir)
            else x := p^.Reg;
end; { Pesquisa }

procedure Insere (x: TipoRegistro; var p: TipoApontador);
begin
  if p = nil
  then begin
       new (p);
       p^.Reg := x;  p^.Esq := nil;  p^.Dir := nil;
       end
  else if x.Chave < p^.Reg.Chave
       then Insere (x, p^.Esq)
       else if x.Chave > p^.Reg.Chave
            then Insere (x, p^.Dir)
            else writeln ('Erro: Registro ja existe na arvore')
end; { Insere }

procedure Inicializa (var Dicionario: TipoDicionario);
begin
  Dicionario := nil;
end; { Inicializa }

procedure Retira (x: TipoRegistro; var p: TipoApontador);
var Aux: TipoApontador;
 
  procedure Antecessor (q: TipoApontador; var r: TipoApontador);
  begin
    if r^.Dir <> nil
    then Antecessor (q, r^.Dir)
    else begin
         q^.Reg := r^.Reg;
         q := r;  r := r^.Esq;
         dispose (q)
         end;
  end; { Antecessor }

begin {---   Retira ---}
  if p = nil
  then writeln ('Erro: Registro nao esta na arvore')
  else if x.Chave < p^.Reg.Chave
       then Retira (x, p^.Esq)
       else if x.Chave > p^.Reg.Chave
            then Retira (x, p^.Dir)
            else if p^.Dir = nil
                 then begin Aux := p;  p := p^.Esq;  dispose(Aux); end
                 else if p^.Esq = nil
                      then begin Aux:=p;  p:=p^.Dir;  dispose(Aux); end
                      else Antecessor (p, p^.Esq);
end; { Retira }

procedure Central (p: TipoApontador);
begin
  if p <> nil
  then begin
       Central (p^.Esq);
       writeln (p^.Reg.Chave);
       Central (p^.Dir);
       end;
end; { Central }

procedure Testa (p: TipoApontador);
  procedure TestaI (p: TipoApontador; pai: integer);
  begin
    if p <> nil then begin
      if p^.Esq <> nil then
        if p^.Reg.Chave < p^.Esq^.Reg.Chave then begin
          writeln ('Erro: Pai ',p^.Reg.Chave ,' menor que filho a esquerda ', p^.Esq^.Reg.Chave);
          halt;
        end;
      if p^.Dir <> nil then
        if p^.Reg.Chave > p^.Dir^.Reg.Chave then begin
          writeln ('Erro: Pai ',p^.Reg.Chave ,' maior que filho a direita ', p^.Dir^.Reg.Chave);
          halt;
        end;
      TestaI (p^.Esq, p^.Reg.Chave);
      TestaI (p^.Dir, p^.Reg.Chave);
    end;
  end;
begin
  if p <> nil then TestaI (p, p^.Reg.Chave);
end;

const max = 10;

var
  Dicionario: TipoDicionario;
  x         : TipoRegistro;
  vetor     : array [1..max] of integer;
  i, j, k, n: integer;

begin

  Inicializa (Dicionario);

  { Gera uma permutação aleatoria de chaves entre 1 e max }
  randomize;
  for i := 1 to max do vetor[i] := i;
  for i := 1 to max do
    begin
    k := 1 + random (max);
    j := 1 + random (max);
    n := vetor[k];
    vetor[k] := vetor[j];
    vetor[j] := n;
    end;
  
  { Insere cada chave na arvore e testa sua integridade apos cada insercao }
  for i := 1 to max do
    begin
    x.Chave := vetor[i];
    Insere (x, Dicionario);
    writeln ('Inseriu chave: ', x.Chave);
    Testa (Dicionario);
    end;
  
  { Retira uma chave aleatoriamente e realiza varias pesquisas }
  for i := 1 to max do
    begin
    k := 1 + random (max);
    n := vetor[k];
    x.Chave := n;
    Retira (x, Dicionario);
    Testa (Dicionario);
    writeln ('Retirou chave: ', x.Chave);
    for j := 1 to max do
      begin
      x.Chave := vetor[1+random (max)];
      if x.Chave <> n
      then begin
           writeln ('Pesquisando chave: ', x.Chave);
           Pesquisa (x, Dicionario);
           end;
      end;
    x.Chave := n;
    Insere (x, Dicionario);
    writeln ('Inseriu chave: ', x.Chave);
    Testa (Dicionario);
    end;

  { Retira a raiz da arvore ate que ela fique vazia }
  for i := 1 to max do
    begin
    x.Chave := Dicionario^.Reg.Chave;
    Retira (x, Dicionario);
    Testa (Dicionario);
    writeln ('Retirou chave: ', x.Chave);
    end;

end. { CriaArvore }