[Pascal] - Métodos de ordenação e Pesquisa

Iniciado por Triplo X, 21 de Setembro , 2008, 03:15:30 AM

tópico anterior - próximo tópico

0 Membros e 1 Visitante estão vendo este tópico.

Triplo X

Resuisitos:

Para entender este tópico é preciso ter pelo menos uma noção deste tópico aqui:

http://www.darkers.com.br/forum/index.php?topic=3584.0

Bem, pascal é muito mais que aquilo, tem também a parte gráfica e também o que vamos ver agora: Métodos de odenação e pesquisa.

É de extrema importância este conhecimento, pois grandes órgãos do Governo já utilizaram sistemas em Pascal com estes métodos um dia.

Acredite, é verdade!

Vamos lá.

Antes de estudar Árvore Binária, é de extrema importância o entendimento de TADs Pilha, Fila e Lista.
Não entrarei em detalhes pois não é o objetivo do tópico. Mais adiante, pesquize na internet e em livros mais detalhes sobre o assunto.


TAD Pilha

PILHA DINÂMICA

pilhadin.pas

CitarUNIT PilhaDin; { TAD PILHA DINAMICA }

INTERFACE
   type
      TipoDado     = integer;
      TipoPilha    = ^TipoElemento;
      TipoElemento = record
                        Dado: TipoDado;
                        Prox: TipoPilha;
                     end;

      procedure Inicializa(var Pilha: TipoPilha);
      procedure Empilha   (var Pilha: TipoPilha; Dado:TipoDado);
      procedure Desempilha(var Pilha: TipoPilha);
      function  Topo      (    Pilha: TipoPilha): TipoDado;
      function  Vazia     (    Pilha: TipoPilha): Boolean;

IMPLEMENTATION
   procedure Inicializa(var Pilha: TipoPilha);
   begin
      Pilha:= nil; {isso garante que a pilha esta vazia}
   end;

   function Vazia(Pilha: TipoPilha): Boolean;
   begin
      if Pilha = nil
      then Vazia:= true
      else Vazia:= false;
   end;

   procedure Empilha(var Pilha: TipoPilha; Dado: TipoDado);
   var
      aux: TipoPilha;
   begin
      new(aux);
      aux^.Prox:= Pilha;
      aux^.Dado:= dado;
      Pilha:= aux;
   end;

   procedure Desempilha(var Pilha: TipoPilha);
   var
      aux: TipoPilha;
   begin
      if not Vazia(Pilha)
      then
         begin
            aux  := Pilha;
            Pilha:= Pilha^.Prox;
            dispose(aux);
         end;
   end;

   function Topo(Pilha: TipoPilha): TipoDado;
   begin
      Topo:= Pilha^.Dado;
   end;

END.



pilhadn1.pas

CitarProgram Decimal_Binario; { usando Pilha Dinamica }
uses PilhaDin, Crt;      { bibliotecas PilhaDin e Crt }
var
   Pilha: TipoPilha;
   resto, valor: integer;
BEGIN
   repeat
      clrscr;
      Inicializa(Pilha);
      writeln('Conversao Decimal->Binario');
      writeln('Utilizando Pilha Dinamica'); writeln;
      write('Digite o numero decimal que deseja converter: ');
      readln(valor);
      repeat
         resto:= valor mod 2;
         Empilha(Pilha,resto);
         valor:= valor div 2;
      until valor = 0;
      write('O binario correspondente eh: ');
      while not Vazia(Pilha) do
      Begin
         valor:= Topo(Pilha);
         write(valor);
         Desempilha(Pilha);
      End;
      writeln; writeln;
      writeln('Pressione ESC para sair ou qualquer outra tecla para solicitar nova conversao.');
   until readkey = #27;
END.



PILHA ESTÁTICA

pilhaest.pas

CitarUNIT PilhaEst; { TAD PILHA ESTATICA }

INTERFACE
   const TAM = 10;
   type
      TipoDado  = integer;   { Definicao do tipo dos dados }
      TipoPilha = record     { Definicao do tipo da pilha  }
                     Dados: array[1..TAM] of TipoDado;
                     Topo : integer;
                  end;
      procedure Inicializa(var Pilha: TipoPilha);
      procedure Empilha   (var Pilha: TipoPilha; Dado: TipoDado);
      procedure Desempilha(var Pilha: TipoPilha);
      function  Topo      (    Pilha: TipoPilha): TipoDado;
      function  Vazia     (    Pilha: TipoPilha): Boolean;
      function  Cheia     (    Pilha: TipoPilha): Boolean;

IMPLEMENTATION
   procedure Inicializa(var Pilha: TipoPilha);
   begin
      Pilha.Topo:= 0; {isso garante que a pilha esta vazia}
   end;

   function Vazia(Pilha: TipoPilha): Boolean;
   begin
      if Pilha.Topo = 0
      then Vazia:= true
      else Vazia:= false;
   end;

   function Cheia(Pilha: TipoPilha): Boolean;
   begin
      if Pilha.Topo >= TAM
      then Cheia:= true
      else Cheia:= false;
   end;

   procedure Empilha(var Pilha: TipoPilha; Dado: TipoDado);
   begin
     if not Cheia(Pilha)
     then
        begin
           Pilha.Topo:= Pilha.Topo + 1;
           Pilha.Dados[Pilha.Topo]:= Dado;
        end;
   end;

   procedure Desempilha(var Pilha: TipoPilha);
   begin
      if not Vazia(Pilha)
      then Pilha.topo:= Pilha.Topo - 1;
   end;

   function Topo(Pilha: TipoPilha): TipoDado;
   begin
      Topo:= Pilha.Dados[Pilha.Topo];
   end;

END.


pilhaet1.pas

CitarProgram Decimal_Binario; { usando Pilha Estatica      }
uses PilhaEst, Crt;      { bibliotecas PilhaEst e Crt }
var
   Pilha: TipoPilha;
   resto, valor: integer;
BEGIN
   repeat
      clrscr;
      Inicializa(Pilha);
      writeln('Conversao Decimal->Binario');
      writeln('Utilizando Pilha Estatica'); writeln;
      write('Digite o numero decimal que deseja converter: ');
      readln(valor);
      repeat
         resto:= valor mod 2;
         Empilha(Pilha,resto);
         valor:= valor div 2;
      until valor = 0;
      write('O binario correspondente eh: ');
      while not Vazia(Pilha) do
      Begin
         valor:= Topo(Pilha);
         write(valor);
         Desempilha(Pilha);
      End;
      writeln; writeln;
      writeln('Pressione ESC para sair ou qualquer outra tecla para solicitar nova conversao.');
   until readkey = #27;
END.

Baixe o aplicativo de estudo de Pilha


TAD Fila

filadin.pas

CitarUNIT FilaDin;

INTERFACE
   Type TipoDado     = integer;
        PontElemento = ^TipoElemento;
        TipoElemento = record
                          Dado : TipoDado;
                          Prox : PontElemento;
                       end;
       TipoFila      = record
                          Inicio: PontElemento;
                          Fim   : PontElemento;
                       end;

   procedure Inicializa(var Fila: TipoFila);
   procedure Insere    (var Fila: TipoFila; Dado:TipoDado);
   procedure Remove    (var Fila: TipoFila);
   function  Primeiro  (    Fila: TipoFila): TipoDado;
   function  Vazia     (    Fila: TipoFila): Boolean;
   procedure Mostra    (    Fila: TipoFila);

IMPLEMENTATION
   procedure Inicializa(var Fila : TipoFila);
   begin
      Fila.Inicio:= nil;
      Fila.Fim   := nil;
   end;

   function Vazia(Fila:Tipofila):boolean;
   begin
      Vazia:= (Fila.Inicio = nil);
   end;

   procedure Insere(var Fila: TipoFila; Dado: TipoDado);
   var
      aux: PontElemento;
   begin
      new(aux);
      aux^.Prox:= nil;
      aux^.Dado:= dado;
      if Fila.Fim <> nil
      then Fila.Fim^.Prox:= aux;
      Fila.Fim:= aux;
      if Fila.Inicio = nil
      then Fila.Inicio:= aux;
   end;

   procedure Remove(var Fila:TipoFila);
   var
      aux: PontElemento;
   begin
   if not Vazia(Fila)
   then
      begin
         aux:= Fila.Inicio;
         Fila.Inicio:= Fila.Inicio^.Prox;
         if Fila.Inicio = nil
         then Fila.Fim:= nil;
         dispose(aux);
      end;
   end;

   function Primeiro(Fila: TipoFila): TipoDado;
   begin
      Primeiro:= Fila.Inicio^.Dado;
      write(Fila.Inicio^.Dado);
   end;

   procedure Mostra(Fila: TipoFila);
   var
      aux: PontElemento;
   begin
      aux:= Fila.Inicio;
      while aux <> nil do
      begin
         write(aux^.Dado:4);
         aux:= aux^.Prox;
      end;
   end;

END.


filadnm.pas

Citarprogram FilaDinamica_Menu;
uses FilaDin, Crt;
var
   FilaGenerica: TipoFila;
   Opcao       : char;
   Valor       : integer;

BEGIN
   Inicializa(FilaGenerica);
   Valor:= 0;

   repeat
      clrscr;
      gotoxy(32,2); write('FILA DINAMICA');
      gotoxy(31,4); write('S -> Inicializar');
      gotoxy(31,5); write('I -> Inserir');
      gotoxy(31,6); write('R -> Remover');
      gotoxy(31,7); write('M -> Mostrar');
      gotoxy(31,8); write('Q -> Sair');
      gotoxy(28,10); write('Escolha, por favor: ');
      Opcao:= upcase(readkey);

      case Opcao of

       'S': begin
               write(Opcao);
               Inicializa(FilaGenerica);
               Valor:= 0;
               gotoxy(30,12);
               write('Fila Inicializada');
            end;

       'I': begin
               write(Opcao);
               Valor:= Valor+1;
               Insere(FilaGenerica, Valor);
               gotoxy(25,12);
               write('Inserido na Fila o valor: ',Valor);
            end;

       'R': begin
               write(Opcao);
               if Vazia(FilaGenerica)
               then
                  begin
                     gotoxy(18,12);
                     write('Nao da pra remover porque a Fila esta vazia.');
                  end
               else
                  begin
                     gotoxy(25,12);
                     write('Removido da Fila o valor: ');
                     Primeiro(FilaGenerica);
                     Remove(FilaGenerica);
                  end;
            end;

       'M': begin
               write(Opcao);
               gotoxy(1,12);
               write('Veja como esta a fila agora:');
               gotoxy(1,13);
               if Vazia(FilaGenerica)
               then write('A Fila esta vazia.')
               else
                  begin
                      Mostra(FilaGenerica);
                      delay(1000);
                  end;
            end;
       'Q': begin
               write(Opcao);
               gotoxy(25,12);
               write('Obrigado pela sua visita');
               delay(1000);
            end;

       else begin
               writeln(Opcao);
               gotoxy(30,12);
               write('Opcao Inexistente');
             end;
       end;
       delay(1000);
   until (Opcao = 'Q');
END.


FILA ESTÁTICA

filaest.pas

CitarUNIT FilaEst;

INTERFACE
   Const TAM = 20; { Constante para a tamanho da fila }
   Type
      TipoDado = integer; { Definicao do tipo dos dados }
      TipoFila = record   { Definicao do tipo da fila   }
                    Dados : array[1..TAM] of TipoDado;
                    Inicio: integer;
                    Fim   : integer;
                    Quant : integer;
                 end;

   { procedimento de inicializacao da fila }
   procedure Inicializa(var Fila: TipoFila);

   { procedimento para inserir um elemento na fila }
   procedure Insere(var Fila: TipoFila; Dado: TipoDado);

   { procedimento para remover um elemento da fila }
   procedure Remove(var Fila: TipoFila);

   { funcao para retornar o dado do topo da fila }
   function Primeiro(Fila: TipoFila): TipoDado;

   { funcao para vericar se a fila esta vazia }
   function Vazia(Fila: TipoFila): Boolean;

   { funcao para mostrar a fila }
   procedure Mostra(Fila: TipoFila);

IMPLEMENTATION
   procedure Inicializa(var Fila : TipoFila);
   begin
      Fila.Quant := 0; { Quantidade de elementos igual a zero }
      Fila.Inicio:= 1; { Inicio com 1 para ficar ajustado na primeira inclusao }
      Fila.Fim   := 0; { Fim com 0 para marcar o ultimo elemento }
   end;

   function Vazia(Fila: TipoFila): Boolean;
   begin
      Vazia := (Fila.Quant = 0); { se quantidade 0 retorna true senao false }
   end;

   function Cheia(Fila: TipoFila): Boolean;
   begin
      Cheia := (Fila.Quant >= TAM);
   end;

   procedure Insere(var Fila: TipoFila; Dado: TipoDado);
   begin
      if not Cheia(Fila)
      then
         begin
            Fila.Fim:= (Fila.Fim MOD TAM) + 1;
            Fila.Dados[Fila.Fim]:= Dado;
            Fila.Quant:= Fila.Quant + 1;
         end;
   end;

   procedure Remove(var Fila: TipoFila);
   begin
      if not Vazia(Fila)
      then
         begin
            Fila.Quant := Fila.Quant - 1;
            Fila.Inicio:= (Fila.Inicio MOD TAM) + 1;
         end;
   end;

   function Primeiro(Fila: TipoFila): TipoDado;
   begin
      Primeiro:= Fila.Dados[Fila.Inicio];
   end;

   procedure Mostra(Fila: TipoFila);
   var
      i: integer;
   begin
      for i:=Fila.Inicio to Fila.Fim do
      begin
         write(Fila.Dados:4);
      end;
   end;

END.


filaetm.pas

Citarprogram FilaEstatica_Menu;
uses FilaEst, Crt;
var
   FilaGenerica: TipoFila;
   Opcao       : char;
   Valor       : integer;

BEGIN
   Inicializa(FilaGenerica);
   Valor:= 0;

   repeat
      clrscr;
      gotoxy(32,2); write('FILA ESTATICA');
      gotoxy(31,4); write('S -> Inicializar');
      gotoxy(31,5); write('I -> Inserir');
      gotoxy(31,6); write('R -> Remover');
      gotoxy(31,7); write('M -> Mostrar');
      gotoxy(31,8); write('Q -> Sair');
      gotoxy(28,10); write('Escolha, por favor: ');
      Opcao:= upcase(readkey);

      case Opcao of

       'S': begin
               write(Opcao);
               Inicializa(FilaGenerica);
               Valor:= 0;
               gotoxy(30,12);
               write('Fila Inicializada');
            end;

       'I': begin
               write(Opcao);
               Valor:= Valor+1;
               Insere(FilaGenerica, Valor);
               gotoxy(25,12);
               write('Inserido na Fila o valor: ',Valor);
            end;

       'R': begin
               write(Opcao);
               if Vazia(FilaGenerica)
               then
                  begin
                     gotoxy(18,12);
                     write('Nao da pra remover porque a Fila esta vazia.');
                  end
               else
                  begin
                     gotoxy(25,12);
                     write('Removido da Fila o valor: ');
                     write(Primeiro(FilaGenerica));
                     Remove(FilaGenerica);
                  end;
            end;

       'M': begin
               write(Opcao);
               gotoxy(1,12);
               write('Veja como esta a fila agora:');
               gotoxy(1,13);
               if Vazia(FilaGenerica)
               then write('A Fila esta vazia.')
               else
                  begin
                      Mostra(FilaGenerica);
                      delay(1000);
                  end;
            end;
       'Q': begin
               write(Opcao);
               gotoxy(25,12);
               write('Obrigado pela sua visita');
               delay(1000);
            end;

       else begin
               writeln(Opcao);
               gotoxy(30,12);
               write('Opcao Inexistente');
             end;
       end;
       delay(1000);
   until (Opcao = 'Q');
END.

Baixe o aplicativo de estudo de Fila  e o aplicativo Lista


TAD Matriz

tadimatri.pas

CitarUNIT TADMatri; {Identifica que esse programa e uma UNIT}

INTERFACE {Local dos cabecalhos das rotinas}

   uses CRT;
   const ORDEM=3;
   type matriz = array[1..ORDEM,1..ORDEM] of integer;
   procedure leMatriz(var Mat:matriz);
   procedure mostraMatriz(Mat:matriz);
   procedure somaMatriz(Mat1, Mat2: matriz; var Mat3:matriz);

IMPLEMENTATION {Local das implementacoes}

   procedure leMatriz(var Mat:matriz);
   var
      indlin: integer;
      indcol: integer;
   Begin
      for indlin:=1 to ordem do
         for indcol:=1 to ordem do
         begin
            write('M(',indlin,',',indcol,']:= ');
            readln(Mat[indlin,indcol]);
         end;
   End;

   procedure mostraMatriz(Mat:matriz);
   var
      indlin: integer;
      indcol: integer;
   Begin
      for indlin:=1 to ordem do
      begin
         for indcol:=1 to ordem do
            write(Mat[indlin,indcol]:8);
         writeln;
      end;
   End;

   procedure somaMatriz(Mat1, Mat2: matriz; var Mat3:matriz);
   var
      indlin: integer;
      indcol: integer;
   Begin
      for indlin:=1 to ordem do
         for indcol:=1 to ordem do
            Mat3[indlin,indcol]:=Mat1[indlin,indcol]+Mat2[indlin,indcol];
   End;

END.


tstmatri.pas

CitarPROGRAM Testa_TAD;
uses crt,TADMatri; {abre unit TADMatriz}
var
   {tipo de dado matriz e o do TAD}
   Matriz1,Matriz2,Matriz3 : matriz;
BEGIN
   clrscr;
   textcolor(green);
   writeln('TIPO ABSTRATO DE DADOS');
   writeln('MATRIZ - Exercicio de Fixacao');

   {le os dados da primeira Matriz}
   writeln; textcolor(yellow);
   writeln('Forneca os dados (numeros inteiros) para a Matriz 1');
   LeMatriz(Matriz1);

   {le os dados da segunda Matriz}
   writeln; textcolor(cyan);
   writeln('Forneca os dados (numeros inteiros) para a Matriz 2');
   LeMatriz(Matriz2);

   {Soma (Matriz3=Matriz1+Matriz2)}
   somaMatriz(Matriz1,Matriz2,Matriz3);

   clrscr;
   textcolor(green);
   writeln('      TIPO ABSTRATO DE DADOS');
   writeln('      MATRIZ - Exercicio de Fixacao');

   {Mostra o conteudo da matriz 1}
   writeln; textcolor(yellow); writeln('       Matriz 1');
   mostraMatriz(Matriz1);

   {Mostra o conteudo da matriz 2}
   writeln; textcolor(cyan); writeln('       Matriz 2');
   mostraMatriz(Matriz2);

   {Mostra o conteudo da matriz 3}
   writeln; textcolor(6); writeln('       Matriz Soma');
   mostraMatriz(Matriz3);

   readkey;
END.



Árvore Binária

Faremos um estudo com a árvore denominada ABB - Árvore Binária de Busca (ou Pesquisa) e a implementaremos para testarmos o seu funcionamento.


O que é uma Árvore Binária?   ____________________________________________________________________________

Toda árvore binária é uma árvore que possui no máximo 2 subárvores (2 filhos) para cada nó. A ABB é uma dessas árvores!
________________________________________________________________________________________________________

A estrutura de uma árvore binária precisa de um campo para o dado a ser armazenado e outros dois para os ponteiros que conectarão seus filhos à esquerda e à direita.

Citartype
  TipoDado = integer;
  TipoArvBin = ^TipoNo;
  TipoNo = record
     Dado : TipoDado;
     Esq, dir : TipoArvBin;
end;

Seguindo a estrutura proposta vamos apresentar um TAD para ABB com as seguintes operações:

Insere(Arv, dado) : Inserção de um nó com o conteúdo de "dado" na árvore "Arv".
Remove(Arv, dado) : Remoção de um nó com o valor "dado" na árvore "Arv".
Inicializa(Arv) : Operação que garante que a árvore está vazia.
Vazia(Arv): Verifica se a árvore está vazia.
Consulta(Arv, dado) : Verifica se um "dado" está na árvore "Arv".
Preordem(Arv) : Mostra a sequência de dados da árvore utilizando o percurso pré-ordem.
Inordem(Arv) : Mostra a sequência de dados da árvore utilizando o percurso in-ordem.
Posordem(Arv) : Mostra a sequência de dados da árvore utilizando o percurso pós-ordem.

Agora que já definimos as operações que o nosso TAD ABB deve ter, vamos para a immplementação de cada uma das operações definidas.
Nesse TAD utilizamos o TAD Fila Dinâmca para resolver o percurso Top Down, como ppode ser analisado no último procedimento do TAD.
Para utilizar o TAD Fila precisamos definir o tipo do dado como sendo painter (TipoDado:painter) para receber o endereço da árvore.

Outra novidade foi a utilização de recursividade que é a melhor forma de resolver os problemas de árvore, pois esta é naturalmente recursiva. A recursividade em programação é chamada de uma rotina pela própria rotina.

Arvore.pas
CitarUnit Arvore;

INTERFACE
   {============== Atencao: Esta parte aqui eh fundamental =================}
   type
   TipoDado   = integer; { Definicao do tipo dos dados                 }
   TipoArvBin = ^TipoNo; { Define um tipo ponteiro para o tipoNo       }
   TipoNo     = record   { Definicao do tipo do elemento da arvore     }
                   Dado: TipoDado;   { Dado a ser colocado/removido    }
                   Esq : TipoArvBin; { Ponteiro pra sub-arv. esquerda  }
                        Dir : TipoArvBin; { Ponteiro pra sub-arv. direita   }
                end;


   {======== Aqui vem os prototipos do TAD arvore binaria de busca =========}

   {procedimento de inicializacao da arvore}
   procedure ArvInicializa(var Arv: TipoArvBin);

   {procedimento para inserir um novo no na arvore}
   procedure ArvInsere(var Arv: TipoArvBin; Dado: TipoDado);

   {funcao para retornar o endereco do maior valor de uma subarvore}
   function ArvMaior(var Arv: TipoArvBin): TipoArvBin;

   {procedimento para remover um no da arvore}
   procedure ArvRemove(var Arv: TipoArvBin; Dado: TipoDado);

   {funcao para procurar um dado na arvore}
   function ArvBusca(Arv: TipoArvBin; Dado: TipoDado): TipoArvBin;

   {funcao para vericar se a arvore esta vazia}
   function ArvVazia(Arv: TipoArvBin): Boolean;

   {Procedimento para mostrar a sequencia de dados no percurso pre-ordem}
   procedure ArvPreOrdem(Arv: TipoArvBin);

   {Procedimento para mostrar a sequencia de dados no percurso in-ordem}
   procedure ArvInOrdem(Arv: TipoArvBin);

   {Procedimento para mostrar a sequencia de dados no percurso pos-ordem}
   procedure ArvPosOrdem(Arv: TipoArvBin);

IMPLEMENTATION

   procedure ArvInicializa(var Arv: TipoArvBin);
   Begin
      Arv:= NIL;
   End;

   function ArvVazia(Arv: TipoArvBin): Boolean;
   Begin
      ArvVazia:= (Arv = nil); {se Arv=nil retorna true senao false}
   End;

   procedure ArvInsere(var Arv: TipoArvBin; Dado: TipoDado);
   begin
      if ArvVazia(Arv)
      then
         begin
            new(Arv);
            Arv^.Dado:= Dado;
            Arv^.Esq:=nil;
            Arv^.Dir:=nil;
         end
      else
        if Dado > Arv^.Dado
        then
           ArvInsere(Arv^.Dir, Dado)
        else
           ArvInsere(Arv^.Esq, Dado);
   End;

   function ArvMaior(var Arv: TipoArvBin): TipoArvBin;
   Begin
      if Arv^.dir = nil
      then
         begin
            ArvMaior:= Arv;
            Arv  := Arv^.Esq;
         end
      else
         ArvMaior:= ArvMaior(Arv^.Dir); {maior sempre estara no ramo direito}
   End;

   procedure ArvRemove(var Arv: TipoArvBin; Dado: TipoDado);
   var
      No: TipoArvBin;
   Begin
      if Arv <> nil
      then
         if Arv^.Dado = Dado
         then
            begin
               No:= Arv;
               if Arv^.Esq = nil
               then {subarvore nao tem filho a esquerda}
                  Arv := Arv^.Dir
               else
                  if Arv^.Dir = nil
                  then {subarvore nao tem filho a direita}
                     Arv := Arv^.Esq
                  else
                     begin {subarvore tem os dois filhos}
                        No:= ArvMaior(Arv^.Esq); {endereco do maior valor a esquerda}
                        Arv^.Dado:= No^.Dado;
                     end;
               dispose(No);
            end
         else
            if Dado > Arv^.Dado
            then
               ArvRemove(Arv^.Dir, Dado) {procura na subarvore direita}
            else
               ArvRemove(Arv^.Esq, Dado); {procura na subarvore esquerda}
   End;

   function ArvBusca(Arv: TipoArvBin; Dado: TipoDado): TipoArvBin;
   Begin
      if Arv = nil
      then
         ArvBusca := nil {dado nao foi encontrado}
      else
         if Arv^.Dado = Dado
         then
            ArvBusca := Arv {dado encontrado, retorna endereco}
         else
            if Dado > Arv^.Dado
            then
               ArvBusca:= ArvBusca(Arv^.Dir, Dado) {procura subarvore direita}
            else
               ArvBusca:= ArvBusca(Arv^.Esq, Dado); {procura subarvore esquerda}
   End;

   procedure ArvPreOrdem(Arv: TipoArvBin);
   Begin
      if Arv <> nil
      then
         begin
            write(Arv^.Dado,', ');
            ArvPreOrdem(Arv^.Esq);
            ArvPreOrdem(Arv^.Dir);
         end;
   End;

   procedure ArvInOrdem(Arv:TipoArvBin);
   Begin
      if Arv <> nil then
      begin
         ArvInOrdem(Arv^.Esq);
         write(Arv^.Dado,', ');
         ArvInOrdem(Arv^.Dir);
      end;
   End;

   procedure ArvPosOrdem(Arv:TipoArvBin);
   Begin
      if Arv <> nil then
      begin
         ArvPosOrdem(Arv^.Esq);
         ArvPosOrdem(Arv^.Dir);
         write(Arv^.Dado,', ');
      end;
   End;

END.



Arvorem.pas

Citarprogram Arvore_Menu;
uses Arvore, Crt;

var
   ArvBinaria: TipoArvBin;
   Opcao     : char;
   Valor     : integer;

BEGIN
   ArvInicializa(ArvBinaria);
   Valor:= 0;

   repeat
      clrscr;
      gotoxy(29,2); write('ARVORE BINARIA DE BUSCA');
      gotoxy(31,4); write('S -> Inicializar');
      gotoxy(31,5); write('I -> Inserir');
      gotoxy(31,6); write('P -> Procurar');
      gotoxy(31,7); write('R -> Remover');
      gotoxy(31,8); write('X -> Mostrar InOrdem');
      gotoxy(31,9); write('Y -> Mostrar PreOrdem');
      gotoxy(31,10); write('Z -> Mostrar PosOrdem');
      gotoxy(31,11); write('Q -> Sair');
      gotoxy(30,13); write('Escolha, por favor: ');
      Opcao:= upcase(readkey);

      case Opcao of

       'S': begin
               write(Opcao);
               ArvInicializa(ArvBinaria);
               gotoxy(30,15);
               write('Arvore Inicializada      ');
               readkey;
            end;

       'I': begin
               write(Opcao);
               gotoxy(25,15);
               write('Valor a ser inserido, por favor: ');
               readln(Valor);
               ArvInsere(ArvBinaria, Valor);
               gotoxy(25,16);
               write('Inserido na Arvore o valor: ',Valor);
               readkey;
            end;

       'P': begin
               write(Opcao);
               if ArvVazia(ArvBinaria)
               then
                  begin
                     gotoxy(30,16);
                     write('A Arvore esta vazia.');
                  end
               else
                  begin
                     gotoxy(25,15);
                     write('Valor a ser procurado, por favor: ');
                     readln(Valor);
                     gotoxy(25,16);
                     if ArvBusca(ArvBinaria,Valor) = nil
                     then
                        write('O valor ',Valor, ' nao estah na arvore.')
                     else
                        write('O valor ',Valor, ' foi encontrado.');
                  end;
                  readkey;
            end;

       'R': begin
               write(Opcao);
               if ArvVazia(ArvBinaria)
               then
                  begin
                     gotoxy(18,16);
                     write('Nao da pra remover porque a Arvore esta vazia.');
                  end
               else
                  begin
                     gotoxy(25,15);
                     write('Valor a se removido, por favor: ');
                     readln(Valor);
                     gotoxy(25,17);
                     {write('Removido da Fila o valor: ');}

                     if ArvBusca(ArvBinaria,Valor) = nil
                     then
                        write('O valor ',Valor, ' nao estah na arvore.')
                     else
                        begin
                           ArvRemove(ArvBinaria,Valor);
                           write('O valor ',Valor, ' foi removido.');
                        end;
                     readkey;
                  end;
            end;

       'X': begin
               write(Opcao);
               gotoxy(1,16);
               write('Percurso da arvore IN ORDEM:');
               gotoxy(1,18);
               if ArvVazia(ArvBinaria)
               then
                  write('A arvore esta vazia.')
               else
                  ArvInOrdem(ArvBinaria);
               readkey;
            end;

       'Y': begin
               write(Opcao);
               gotoxy(1,16);
               write('Percurso da arvore PRE ORDEM:');
               gotoxy(1,18);
               if ArvVazia(ArvBinaria)
               then
                  write('A arvore esta vazia.')
               else
                  ArvPreOrdem(ArvBinaria);
               readkey;
            end;

       'Z': begin
               write(Opcao);
               gotoxy(1,16);
               write('Percurso da arvore POS ORDEM:');
               gotoxy(1,18);
               if ArvVazia(ArvBinaria)
               then
                  write('A arvore esta vazia.')
               else
                  ArvPosOrdem(ArvBinaria);
               readkey;
            end;

       'Q': begin
               write(Opcao);
               gotoxy(29,16);
               write('Obrigado pela sua visita');
               delay(1000);
            end;

       else
            begin
               writeln(Opcao);
               gotoxy(30,15);
               write('Opcao Inexistente');
               readkey;
             end;
       end;
       {delay(1000);}
   until (Opcao = 'Q');

END.


* Os aplicativos citados acima são apenas para você que é estudante pascal visualizar o funcionamento de pilha, fila e lista.


Pilha:




Fila:




Lista:




Aplicativos produzidos por: Elieser Ademir de Jesus - 14/07/2004


Até a próxima...
Não me venha dizer que é melhor que alguém que eu te espanco!
Todos não passamos de ratinhos que morrerão um dia como todos os outros...