unit Drzewa;
interface
type AVL=^wezel; //typ wskaznikowy drzewa wyważonego
wezel=record
el:Integer;
h:Integer;
lewy:AVL;
prawy:AVL;
licznik:Integer;
wywazenie:-1..+1; //z dodatkowa informacja o wspólczynniku wywazenia wezla
end; {czyli róznicy wys. prawego i lewego podrzewa, jeli
hl<hp wywaz=1: przeważone w jakąs strone
hl=hp wywaz=0: równowaga
hl>hp wywaz=-1: konieczne jest ponowne wywazenie}
type tablica = array of integer;
procedure utworz_d_wywaz(tab:tablica;left:Integer;right:Integer);
//procedure wstaw_d(key:Integer);
procedure wyswietl_inord(tmp:AVL);
function wys_d(tmp:AVL):Integer;
procedure wstaw_d_wywaz(key:Integer;var current:AVL;var wys_poddrz:Boolean);
procedure usun_d_wywaz(key:Integer;var current:AVL; var wys_poddrz_u:boolean);
procedure wywazanie_P(var current:AVL; var wys_poddrz_u:boolean);
procedure wywazanie_L(var current:AVL; var wys_poddrz_u:boolean);
procedure wyszukaj_d(key:Integer;tmp:AVL);
procedure usun_caled(var tmp:AVL);
procedure przegladaj_d(tmp:AVL);
var
root,parent_wywaz:AVL; //korzen drzewa AVL
wys_calk:Integer; //calkowita wys drzewa
wys_poddrz:Boolean; //przechowuje info czy wys. poddrzewa zwiekszyla sie przy wstawianiu
wys_poddrz_u:Boolean; //przechowuje info czy wys. poddrzewa zwiekszyla sie przy usuwaniu
wysokosc:Integer; //zlicza rekurencje dzieki czemu daje wys wezla przy jego wstawianiu
ilosc_wywazen:Integer; //przechowuje info o ilosci wywazen podczas wstawiania n elementow
ilosc_wywazen_u:Integer; //przechowuje info o ilosci wywaze podczas usuwania n elementow
wst_polowkowe,tworzenie_polowkowe:Boolean;
implementation
//=====================Tworzenie drzewa=======================================//
procedure utworz_d_wywaz(tab:tablica;left:Integer;right:Integer);
var
indeks:Integer;
begin
if (left<=right) then
begin
indeks:=(left+right) div 2;
if (tworzenie_polowkowe=True) then
wst_polowkowe:=True;
wstaw_d_wywaz(tab[indeks],root,wys_poddrz);
utworz_d_wywaz(tab,left,indeks-1);
utworz_d_wywaz(tab,indeks+1,right);
end;
end;
//=====================Wstawianie nowego węzla================================//
procedure wstaw_d_wywaz(key:Integer; var current:AVL;var wys_poddrz:Boolean);
var
tmp1,tmp2:AVL;
begin
if (current=nil) then //warunek stopu dla rekurencji, brak klucz wiec trzeba
begin // go wstawic
New(current);
with current^ do // i dlatego sie ono nie wykonuje
begin
el:=key;
lewy:=nil;
prawy:=nil;
h:=wysokosc;
licznik:=1;
wywazenie:=0;
end;
wysokosc:=0; //zerowanie wysokosci aby dla nstapnej zmiennej znowu byla ona liczona
if (wst_polowkowe=False) then //jezeli odbywa sie wstawianie polowkowe
wys_poddrz:=True //to flaga od wywazania caly czas jest false
else wys_poddrz:=False;
end
else if (key < current^.el) then
begin
Inc(wysokosc);
wstaw_d_wywaz(key,current^.lewy,wys_poddrz); //wywolanie rekurencyjne
if wys_poddrz then //jezeli urosla lewa galaz
case current^.wywazenie of
1: begin
current^.wywazenie:=0;
wys_poddrz:=false;
end;
0: current^.wywazenie:=-1;
-1: begin //wywaz drzewo
Inc(ilosc_wywazen);
tmp1:=current^.lewy; //wskaznik tmp1 wskazuje na lewe podrz biezacego
//czyli na A w obu przyp.
//w LL current= B, w LP current= C
if (tmp1^.wywazenie=-1) then
begin //pojedyńcze wywazanie LewoLewo
current^.lewy:=tmp1^.prawy; //jako lewe poddrz B wstaw prawe A
tmp1^.prawy:=current; //podnies A, ustaw B jako jego prawe poddrz
current^.wywazenie:=0;
//if (current^.right<>nil) then Inc(current^.right^.wys);
//if (tmp1^.left<>nil) then Dec(tmp1^.left^.wys);
//Inc(current^.wys); //zwiekszenie wysokosci bo B opadlo na dól
//Dec(tmp1^.wys); //zmniejszenie wys bo A poszlo do gory
current:=tmp1;
end
else
begin //podwójna zamiana LP
tmp2:=tmp1^.prawy; //wskaznk tmp2 wskazuje na prawo poddrz tmp1 (na B)
tmp1^.prawy:=tmp2^.lewy;//jako prawe poddrz A wstaw lewe poddrz B
tmp2^.lewy:=tmp1; //wstaw A jako prawe poddrz B
current^.lewy:=tmp2^.prawy; //wstaw prawe poddrz B jako lewe poddrz C
tmp2^.prawy:=current; //wstaw poddrz C jako prawe poddrz B
//if (tmp1^.right<>nil) then Dec(tmp1^.right^.wys);
//if (current^.left<>nil) then Dec(current^.left^.wys);
//Inc(current^.wys);
//tmp2^.wys:=tmp2^.wys-2;
if (tmp2^.wywazenie=-1) then
current^.wywazenie:=1
else
current^.wywazenie:=0;
if (tmp2^.wywazenie=1) then
tmp1^.wywazenie:=-1
else
tmp1^.wywazenie:=0;;
current:=tmp2;
end;
current^.wywazenie:=0; // tutaj zerujemy tmp2 bo wczesniej bylo podstawienie current:=tmp2;
wys_poddrz:=false;
end;
end;
end
else
if ( key > current^.el) then
begin
Inc(wysokosc);
wstaw_d_wywaz(key,current^.prawy,wys_poddrz); //rekurencyjne wywolanie dla prawego poddrzewa
if wys_poddrz then //urosla prawa galaz
case current^.wywazenie of
-1: begin //jak wstawiam lewego syna to wspolczynnik wywazenia ojca zmienia sie na -1
current^.wywazenie:=0; //tutaj gdy dostawie do niego prawego podsyna to jego wspolczynnim znowu wraca do 0
wys_poddrz:=false; // czyli do stanu równowagi
end;
0: current^.wywazenie:=1;
1: begin //wywaz drzewo
Inc(ilosc_wywazen);
tmp1:=current^.prawy; //pod tmp1 wstawiam prawy w zwiazku z lusstrzanym odbiciem
if (tmp1^.wywazenie=1) then
begin //pojedyncza zamiana PP
current^.prawy:=tmp1^.lewy;
tmp1^.lewy:=current;
current^.wywazenie:=0;
//if (current^.left<>nil) then Inc(current^.left^.wys);
//if (tmp1^.right<>nil) then Dec(tmp1^.right^.wys);
//Inc(current^.wys);
//Dec(tmp1^.wys);
current:=tmp1; // current zostaje na tym samym poziomie, podstawinie wykonuje sie ze wzgkedu na podniesienie A
end //a obnizenie B, na które wczesniej wskazywal current
else
begin //podwójna zamiana PL
tmp2:=tmp1^.lewy;
tmp1^.lewy:=tmp2.prawy;
tmp2^.prawy:=tmp1;
current^.prawy:=tmp2^.lewy;
tmp2^.lewy:= current;
//if (tmp1^.left<>nil) then Dec(tmp1^.left^.wys);
//if (current^.right<>nil) then Dec(current^.right^.wys);
//Inc(current^.wys);
// tmp2^.wys:=tmp2^.wys-2;
if (tmp2^.wywazenie=1) then
current^.wywazenie:=-1
else
current^.wywazenie:=0;
if (tmp2^.wywazenie=-1) then
tmp1^.wywazenie:=1
else
tmp1^.wywazenie:=0;
current:=tmp2;
end;
current^.wywazenie:=0;
wys_poddrz:=false;
end;
end;
end
else
wys_poddrz:=False;
end;
//==============Usuwanie elementu z drzewa====================================//
procedure wywazanie_L(var current:AVL; var wys_poddrz_u:Boolean);
var
tmp1,tmp2:AVL;
w1,w2:-1..+1;
begin // wys_poddrz_u=true, prawa galaz sie zmniejszyla
case current^.wywazenie of
1: current^.wywazenie:=0; //jezeli bylo przechylone to teraz jest zrownowazone
0: begin
current^.wywazenie:= -1;
wys_poddrz_u:=False;
end;
-1: begin //wywazanie
Inc(ilosc_wywazen_u);
tmp1:=current^.lewy;
w1:=tmp1^.wywazenie;
if (w1<=0) then //pojedyncza zamiana LL
begin
current^.lewy:=tmp1^.prawy; //rotacja LL
tmp1^.prawy:=current;
if (w1=0) then
begin
current^.wywazenie:=-1;
tmp1^.wywazenie:=1;
wys_poddrz_u:=false;
end
else
begin
current^.wywazenie:=0;
tmp1^.wywazenie:=0;
end;
current:=tmp1;
end
else
begin //podwójna zamiana LP
tmp2:=tmp1^.prawy;
w2:=tmp2^.wywazenie;
tmp1^.prawy:=tmp2^.lewy;
tmp2^.lewy:=tmp1;
current^.lewy:=tmp2^.prawy;
tmp2^.prawy:=current;
if (w2=-1) then
current^.wywazenie:=1
else
current^.wywazenie:=0;
if (w2=1) then
tmp1^.wywazenie:=-1
else
tmp1^.wywazenie:=0;
current:=tmp2;
tmp2^.wywazenie:=0;
end;
end;
end;
end;
procedure wywazanie_P(var current:AVL; var wys_poddrz_u:Boolean);
var
tmp1,tmp2:AVL;
w1,w2:-1..+1;
begin // wys_poddrz_u=true, lewa galaz sie zmniejszyla
case current^.wywazenie of
-1: current^.wywazenie:=0; //jezeli bylo przechylone to teraz jest zrownowazone
0: begin
current^.wywazenie:= 1;
wys_poddrz_u:=False;
end;
1: begin //wywazanie
Inc(ilosc_wywazen_u);
tmp1:=current^.prawy;
w1:=tmp1^.wywazenie;
if (w1>=0) then //pojedyncza zamiana PP
begin
current^.prawy:=tmp1^.lewy; //rotacja PP
tmp1^.lewy:=current;
if (w1=0) then
begin
current^.wywazenie:=1;
tmp1^.wywazenie:=-1;
wys_poddrz_u:=false;
end
else
begin
current^.wywazenie:=0;
tmp1^.wywazenie:=0;
end;
current:=tmp1;
end
else
begin //podwójna zamiana PL
tmp2:=tmp1^.lewy;
w2:=tmp2^.wywazenie;
tmp1^.lewy:=tmp2^.prawy;
tmp2^.prawy:=tmp1;
current^.prawy:=tmp2^.lewy;
tmp2^.lewy:=current;
if (w2=1) then
current^.wywazenie:=-1
else
current^.wywazenie:=0;
if (w2=-1) then
tmp1^.wywazenie:=1
else
tmp1^.wywazenie:=0;
current:=tmp2;
tmp2^.wywazenie:=0;
end;
end;
end;
end;
procedure usun_d_wywaz(key:Integer;var current:AVL; var wys_poddrz_u:boolean);
var
q:AVL;
procedure usun_w2sons(var p:AVL; var wys_poddrz_u:Boolean);
var pomocn:AVL;
begin //wys_poddrz_u=False //usuwanie dla przypadku gdy wezel
if (p^.prawy<>nil) then //ma dwóch synów
begin
usun_w2sons(p^.prawy,wys_poddrz_u);
if wys_poddrz_u then
wywazanie_L(p,wys_poddrz_u);
end
else
begin
q^.el:=p^.el;
q:=p;
p:=p^.lewy;
wys_poddrz_u:=True;
end;
end;
begin //usun
if(current=nil) then
begin
//Writeln('Brak klucza w drzewie!!!');
wys_poddrz_u:=False;
end
else if (key<current^.el) then
begin
usun_d_wywaz(key,current^.lewy,wys_poddrz_u);
if wys_poddrz_u then
wywazanie_P(current,wys_poddrz_u);
end
else if (key>current^.el) then
begin
usun_d_wywaz(key,current^.prawy,wys_poddrz_u);
if wys_poddrz_u then
wywazanie_L(current,wys_poddrz_u);
end
else
begin //usuwanie current^
q:=current;
if (q^.prawy=nil) then
begin
current:=q^.lewy;
wys_poddrz_u:=true;
end
else
if (q^.lewy=nil) then
begin
current:=q^.prawy;
wys_poddrz_u:=true;
end
else
begin
usun_w2sons(q^.lewy,wys_poddrz_u); //usuwanie dwóch synów metoda raz w lewo i
if wys_poddrz_u then // do konca w prawo
wywazanie_P(current,wys_poddrz_u);
end;
Dispose(q);
end;
end;
//========================Wyszukiwanie wezla w drzewie========================//
procedure wyszukaj_d(key:Integer;tmp:AVL);
begin
if (tmp<>nil) and (key<>tmp^.el) then
if (key < tmp^.el) then
wyszukaj_d(key,tmp^.lewy)
else
wyszukaj_d(key,tmp^.prawy)
{else if (tmp<>nil) then
Writeln(tmp^.klucz); }
end;
//=====================Usuwanie calego drzewa================================//
procedure usun_caled(var tmp:AVL);
begin
if (tmp<>nil) then
begin
usun_caled(tmp^.lewy);
usun_caled(tmp^.prawy);
Dispose(tmp);
tmp:=nil;
end;
end;
//====================Przegladanie drzewa======================================//
procedure przegladaj_d(tmp:AVL);
begin
if (tmp<>nil) then
begin
przegladaj_d(tmp^.lewy);
Inc(tmp^.el);
przegladaj_d(tmp^.prawy);
end;
end;
//========================Wysokosc drzewa=====================================//
function wys_d(tmp:AVL):Integer;
begin
if (tmp<>nil) then
begin
wys_d(tmp^.lewy); //rekurencyjne wywolanie lewego poddrzewa
if (tmp^.h > wys_calk) then
wys_calk:=tmp^.h;
wys_d(tmp^.prawy); //rekurencyjne wywoalnie prawego poddrzewa
end;
Result:=wys_calk;
end;
//========================Wywswietlanie w porządku inorder===================//
procedure wyswietl_inord(tmp:AVL);
begin
if (tmp<>nil) then
begin
wyswietl_inord(tmp^.lewy);
Write(tmp^.el);
Writeln(' ',tmp^.wywazenie);
wyswietl_inord(tmp^.prawy);
end;
end;
end.