Imprimir página - [Pascal] - Métodos de ordenação e Pesquisa

Título: [Pascal] - Métodos de ordenação e Pesquisa
Enviado por: Triplo X online 21 de Setembro , 2008, 03:15:30 AM

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 (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 (//http://triplox.webcindario.com/darkers/pascal/aplicativo_pilha.zip)

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 (//http://triplox.webcindario.com/darkers/pascal/aplicativofila.zip) e o aplicativo Lista (//http://triplox.webcindario.com/darkers/pascal/aplicativolista.zip)

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:

(//http://img88.imageshack.us/img88/2965/pilhamenorfd0.gif) (//http://img225.imageshack.us/img225/4671/pilhafc7.gif)

Fila:

(//http://img243.imageshack.us/img243/3650/filamenorqb2.gif) (//http://img216.imageshack.us/img216/5438/filaho1.gif)

Lista:

(//http://img142.imageshack.us/img142/108/listamenorer4.gif) (//http://img329.imageshack.us/img329/9900/listagk8.gif)

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

Até a próxima...

FORUM DARKERS

Tecnologia & Informática => Programação => Tópico iniciado por: Triplo X online 21 de Setembro , 2008, 03:15:30 AM