Ir ao conteúdo
  • Cadastre-se

ajuda com arvore avl


jalisson

Posts recomendados

preciso de ajuda para fazer a remoção de qualquer no da minha arvore avl e ela deve continuar ordenada

o codigo é esse abaixo

program arvoreavl;

{$APPTYPE CONSOLE}

uses

SysUtils,

Crt32D7;

type

PtrNodoArvBin = ^NodoArvBin;

NodoArvBin = Record

Conteudo:Integer;

ArvEsq,ArvDir,Pai:PtrNodoArvBin;

End;

procedure InicializaAVL(var Raiz:PtrNodoArvBin);

begin

Raiz:=NIL;

end;

//--------------------------------------------------------------------------------

Function InsereArvBinPesq(var raiz:PtrNodoArvBin;x:integer):PtrNodoArvBin;

var p, ptr,ant : PtrNodoArvBin;

begin

new(p);

new(ant);

p^.Conteudo := x;

p^.ArvEsq := NIL;

p^.ArvDir := NIL;

ptr := raiz;

while ptr <> NIL do

begin

ant := ptr;

if x > ptr^.Conteudo then

ptr := ptr^.ArvDir else

ptr := ptr^.ArvEsq;

end;

if ptr = raiz then

begin

p^.Pai := NIL;

raiz := p;

end

else

begin

p^.Pai := ant;

if x > ant^.Conteudo then

ant^.ArvDir := p else

ant^.ArvEsq := p;

end;

InsereArvBinPesq := p;

end;

//--------------------------------------------------------------------------------

function Maior(a,b:integer):integer;

begin

if a > b then

Maior := a else

Maior := b;

end;

function Altura (raiz:PtrNodoArvBin):integer;

begin

if raiz = NIL then

Altura := -1 else

Altura := 1+Maior(altura(raiz^.ArvEsq),altura(raiz^.ArvDir));

end;

//--------------------------------------------------------------------------------

Function AchaPivo (nodo:PtrNodoArvBin):PtrNodoArvBin;

var ptr : PtrNodoArvBin;

begin

ptr := nodo;

while (ptr <> NIL) AND (abs(altura(ptr^.ArvDir)-altura(ptr^.ArvEsq))<2) do

ptr := ptr^.Pai;

AchaPivo := ptr;

end;

//--------------------------------------------------------------------------------

Function MaiorValor (Raiz:PtrNodoArvBin):PtrNodoArvBin;

begin

if Raiz <> NIL then

MaiorValor:=MaiorValor (Raiz^.ArvDir) else

MaiorValor:=Raiz;

end;

Function MenorValor (Raiz:PtrNodoArvBin):PtrNodoArvBin;

begin

if Raiz <> NIL then

MenorValor:=MenorValor (Raiz^.ArvEsq) else

MenorValor:=Raiz;

end;

Function Busca (x: integer; var raiz: PtrNodoArvBin;var achou: boolean):PtrNodoArvBin;

Var

p: PtrNodoArvBin;

Begin

p:=raiz;

achou:=false;

While (not achou) and (p<>nil) do

If p^.Conteudo = x Then

achou:=true

Else

If p^.Conteudo > x Then

p:=p^.ArvEsq

Else p:=p^.ArvDir;

// Busca:=p;

result :=p;

End;

Function RemoveNodo(var raiz:PtrNodoArvBin;x:Integer;var pairem:PtrNodoArvBin):boolean;

var ptr, aux, pai, filho : PtrNodoArvBin;

achou:boolean;

begin

ptr := busca(x,raiz,achou);

if ptr = NIL

then RemoveNodo := FALSE

else begin

if (ptr^.ArvEsq = NIL) AND (ptr^.ArvDir = NIL)

then if ptr = raiz

then raiz := NIL

else begin

pai := ptr^.Pai;

if ptr = pai^.ArvEsq

then pai^.ArvEsq := NIL

else pai^.ArvDir := NIL;

end

else begin

aux := MaiorValor(ptr^.ArvEsq);

if aux <> NIL

then begin

pai := aux^.Pai;

filho := aux^.ArvEsq;

if pai = ptr

then ptr^.ArvEsq := filho

else pai^.ArvDir := filho;

end

else begin

aux := MenorValor(ptr^.ArvDir);

pai := aux^.Pai;

filho := aux^.ArvDir;

if pai = ptr

then ptr^.ArvDir := filho

else pai^.ArvEsq := filho;

end;

if filho <> NIL

then filho^.Pai := pai;

ptr^.Conteudo := aux^.Conteudo;

ptr := aux;

end;

pairem := ptr^.Pai;

dispose(ptr);

end;

result:=true;

end;

//--------------------------------------------------------------------------------

Procedure RotSimplesDir(var raiz:PtrNodoArvBin;pivo:PtrNodoArvBin);

var pai,aux,subarv2 : PtrNodoArvBin;

begin

pai := pivo^.Pai;

aux := pivo^.ArvEsq;

subarv2 := aux^.ArvDir;

pivo^.ArvEsq := subarv2;

aux^.ArvDir := pivo;

if subarv2 <> NIL then

subarv2^.Pai := pivo;

pivo^.Pai := aux;

aux^.Pai := pai;

if pai <> NIL then

if pivo = pai^.ArvEsq then

pai^.ArvEsq := aux else

pai^.ArvDir := aux else

raiz := aux;

end;

//--------------------------------------------------------------------------------

Procedure RotSimplesEsq(var raiz:PtrNodoArvBin;pivo:PtrNodoArvBin);

var pai,aux,subarv2 : PtrNodoArvBin;

begin

pai := pivo^.Pai;

aux := pivo^.ArvDir;

subarv2 := aux^.ArvEsq;

pivo^.ArvDir := subarv2;

aux^.ArvEsq := pivo;

if subarv2 <> NIL then

subarv2^.Pai := pivo;

pivo^.Pai := aux;

aux^.Pai := pai;

if pai <> NIL then

if pivo = pai^.ArvDir then

pai^.ArvDir := aux else

pai^.ArvEsq := aux else

raiz := aux;

end;

//--------------------------------------------------------------------------------

Procedure RotDuplaDir(var raiz:PtrNodoArvBin;pivo:PtrNodoArvBin);

begin

RotSimplesEsq(raiz,pivo^.ArvEsq);

RotSimplesDir(raiz,pivo);

end;

//--------------------------------------------------------------------------------

Procedure RotDuplaEsq (var raiz:PtrNodoArvBin;pivo:PtrNodoArvBin);

begin

RotSimplesDir(raiz,pivo^.ArvDir);

RotSimplesEsq(raiz,pivo);

end;

//--------------------------------------------------------------------------------

Procedure AjustaArvore(var raiz:PtrNodoArvBin;pivo:PtrNodoArvBin);

var aux : PtrNodoArvBin;

begin

if pivo <> NIL then

if altura(pivo^.ArvEsq) > altura(pivo^.ArvDir)then

begin

aux := pivo^.ArvEsq;

if altura(aux^.ArvEsq) > altura(aux^.ArvDir)then

RotSimplesDir(raiz,pivo) else

RotDuplaDir(raiz,pivo);

end else

begin

aux := pivo^.ArvDir;

if altura(aux^.ArvDir) > altura(aux^.ArvEsq) then

RotSimplesEsq(raiz,pivo) else

RotDuplaEsq(raiz,pivo);

end;

end;

//--------------------------------------------------------------------------------

{ Function RemoveAVL(var raiz:PtrNodoArvBin;x:integer):boolean;

var p,nodo,pivo,aux : PtrNodoArvBin;

begin

if RemoveNodo(raiz,x,pivo)

then while pivo <> NIL do

begin

pivo := AchaPivo(pivo);

AjustaArvore(raiz,pivo);

end;

end; }

Procedure InsereAVL(var raiz:PtrNodoArvBin;x:integer);

var nodo,pivo : PtrNodoArvBin;

begin

new(nodo);

nodo := InsereArvBinPesq(raiz,x);

pivo := AchaPivo(nodo);

AjustaArvore(raiz,pivo);

end;

//--------------------------------------------------------------------------------

Function RemoveAVL(var raiz:PtrNodoArvBin;x:integer):boolean;

var pivo : PtrNodoArvBin;

begin

if RemoveNodo(raiz,x,pivo) then

while pivo <> NIL do

begin

pivo := AchaPivo(pivo);

AjustaArvore(raiz,pivo);

end;

result:=true;

end;

procedure mostrarOrdem(var raiz:PtrNodoArvBin;x:integer);

begin

if raiz<> nil then

begin

mostrarOrdem(raiz^.ArvEsq,x);

writeln(raiz^.Conteudo);

mostrarOrdem(raiz^.ArvDir,x);

end;

end;

procedure mostrarPreOrdem(var raiz:PtrNodoArvBin;x:integer);

begin

if raiz<> nil then

begin

writeln(raiz^.Conteudo);

mostrarPreOrdem(raiz^.ArvEsq,x);

mostrarOrdem(raiz^.ArvDir,x);

end;

end;

procedure Menu;

begin

writeln(' Menu ');

writeln;

writeln(' 1. Insere diretamente avl ');

writeln(' 2. Insere normal ');

writeln(' 3. Imprime Pre Ordem ');

writeln(' 4. Ajusta arvore se inseriu normal');

writeln(' 5. Pesquisar em manutenção ');

writeln(' 6. remover avl');

writeln(' 7. Fechar ');

writeln;

write('Digite a opcao desejada: ');

end;

function obtemescolha : integer;

var

x : integer;

begin

readln (x);

while (x < 1) or (x > 7) do

begin

write ('Digite uma opcao valida do menu: ');

readln (x);

end;

result := x;

end;

var Raiz,pivo,z:PtrNodoArvBin;

conteudo:integer;

opcao:integer;

resp : char;

achou:boolean;

begin

InicializaAVL(raiz);

achou:=false;

Menu;

opcao := obtemescolha;

writeln;

while (opcao > 0) and (opcao < 7) do

begin

if opcao = 1 then

begin

clrscr;

repeat

writeln('Digite um valor: ');

readln(conteudo);

insereAVL(raiz,conteudo);

writeln('Deseja continuar S/N?: ');

readln(resp);

clrscr;

until upcase(resp) = 'N';

end;

if opcao = 2 then

begin

clrscr;

repeat;

writeln('Digite um valor: ');

readln(conteudo);

inserearvBinpesq(raiz,conteudo);

writeln('Deseja continuar S/N?: ');

readln(resp);

clrscr;

until upcase(resp) = 'N';

end;

if opcao = 3 then

begin

clrscr;

mostrarPreOrdem(raiz,conteudo);

readln;

clrscr;

end;

if opcao = 4 then

begin

clrscr;

pivo:=achapivo(raiz);

ajustaarvore(raiz,pivo);

writeln('Arvore ajustada');

readln;

clrscr;

end;

if opcao = 5 then

begin

clrscr;

writeln('informe o valor');

readln(conteudo);

z:= Busca(conteudo,Raiz,achou);

if (achou=true) then

writeln(z.Conteudo)

else

writeln('nao achou');

readln;

clrscr;

end;

if opcao=6 then

begin

writeln('informe o valor');

readln(conteudo);

//// pivo:=achapivo(raiz);

// removenodo(raiz,conteudo,pivo);

removeavl(raiz,conteudo);

readln;

clrscr;

end;

writeln;

Menu;

opcao:= obtemescolha;

end;

end.

Link para o comentário
Compartilhar em outros sites

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas comunidades sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...