program drzew;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
type
TDana = integer; // deklaracja jakiejś danej
Drzewo = ^TDrzewo; // typ wskazujący na drzewko bo przecież musimy pamiętac jego potomków...
TDrzewo = record // drzewko
licznik,stan,etykieta: TDana; // to jest nasza dana, może być ich oczywiście więcej
przodek,lewy,prawy: Drzewo; // przodek,potomkowie
wywaz: -1..1;
end;
var
timeEnd,TimeStart,freq,timestart1,timeend1:Int64;
czas:extended;
T:array of Longint;
Ba:array of Longint;
B:array of Longint;
korzen,m,elem,p,a,j,i,n,z,k,zakres: longint;
dana: TDana;
drzewko: Drzewo;
wys:integer;
h:Boolean;
f:TextFile;
// procedura wstawiania jednego elementu na liste
procedure DrzewoAVL;
//////////////////////////////////////////////
procedure Wstaw(var W : Drzewo;var Co : Longint);
var pos, nowy : Drzewo;
begin
pos:=W;
New(nowy);
nowy^.etykieta:=Co;
nowy^.lewy:=nil;
nowy^.prawy:=nil;
if W=nil then
begin
W:=nowy;
W^.przodek:=nil;
end
else
while 1=1 do
begin
if pos^.etykieta>=Co then
if pos^.lewy<>nil then pos:=pos^.lewy else
begin
nowy^.przodek:=pos;
pos^.lewy:=nowy;
break;
end
else
if pos^.prawy<>nil then pos:=pos^.prawy else
begin
nowy^.przodek:=pos;
pos^.prawy:=nowy;
break;
end;
end;
end;
///////////////////////////////////////////////////
procedure Create(var node:Drzewo; l, r : integer); //metoda polowienia
var
mid : integer;
begin
mid:=(l+r) div 2;
// Write(ba[mid],' ');
//Writeln('end');
Wstaw(node,ba[mid]);
if (mid-1)>=l then Create(node^.lewy, l,(mid-1));
if (mid+1)<=r then Create(node^.prawy, (mid+1),r);
end;
///////////////////////////////////////////////////
procedure drukuj(W : Drzewo); // wypisywanie drzewa
begin
if W <> nil then
begin
drukuj(W^.Lewy); //
//drukuj(W^.Prawy);
Write(W^.Etykieta,' ');
drukuj(W^.Prawy);
end;
end;
//////////////////////////////////////////////
Procedure Wyszukiwanie( var W : drzewo); // wyszukiwanie elementu
var
x:longint;
Begin
if W <> nil then
begin
if elem = W^.etykieta then x:=1; //Writeln('tak'); end;
if elem < W^.etykieta then Wyszukiwanie(W^.lewy)
else Wyszukiwanie(W^.prawy);
end;
END;
//////////////////////////////////////////////
{ procedure drukujdrzewo(w:drzewo;h:integer);
var i:integer;
begin
if w <> nil then
with w^ do
begin
drukujdrzewo(lewy,h+1);
for i:=1 to h do write(' ');
writeln(etykieta);
drukujdrzewo(prawy,h+1);
end;
End;}
///////////////////////////////////////////////
procedure Wysokosc(w:drzewo; ile : integer);
begin
if (w<>nil) then
begin
// Writeln(ile);
Wysokosc(w^.lewy, ile+1);
Wysokosc(w^.prawy, ile+1);
if ile>wys then wys:=ile;
end;
end;
//////////////////////////////////////////////
procedure quicksortS(start,stop:longint);
var
h,i,j,x:longint;
BEgin
i:=start;
j:=stop;
x:=ba[(start+stop)div 2];
repeat
while (ba[j]>x) do j:=j-1;
while (ba[i]<x) do i:=i+1;
if (i<=j)
then
BEgin
h:=ba[i];
ba[i]:=ba[j];
ba[j]:=h;
j:=j-1;
i:=i+1;
End;
until (i>=j);
if (start<j) then quicksortS(start, j);
if (i<stop) then quicksortS(i, stop);
end;
Procedure Przegladanie(var W:Drzewo);
Begin
if W<>nil then
BEgin
Przegladanie(W^.lewy);
Przegladanie(W^.Prawy);
W^.etykieta:=W^.etykieta+1;
End;
End;
Procedure Wstawianie(x:Longint ; var w:Drzewo; var h:boolean);
var p1,p2:Drzewo;
Begin
BEgin
if w=nil then
BEgin
new(w);
h:=true;
with w^ do
begin
etykieta:=x;
licznik:=1;
lewy:=nil;
prawy:=nil;
wywaz:=0;
end
end
else //w<>nil drzewo nie jest puste.
if x<w^.etykieta then
BEgin
wstawianie(x,W^.lewy,h);
if h then // urosła lewa galaz
case W^.wywaz of
1: begin
W^.wywaz:=0;
h:=false;
end;
0: W^.wywaz:=-1;
-1: begin
p1:=W^.lewy;
if p1^.wywaz=-1 then
begin // pojedyncza zamiana LL
w^.lewy:=p1^.prawy;
p1^.prawy:=W;
W^.wywaz:=0;
w:=p1;
end
else // podwojna zamiana LP
begin
p2:=p1^.prawy;
p1.prawy:=p2^.lewy;
p2^.lewy:=p1;
w^.lewy:=p2^.prawy;
p2^.prawy:=w;
if p2^.wywaz=-1 then w^.wywaz:=1
else w^.wywaz:=0;
if p2^.wywaz=1 then p1^.wywaz:=-1
else p1^.wywaz:=0;
w:=p2;
End;
w^.wywaz:=0;
h:=false;
end
end
ENd
ELSE
if x>=w^.etykieta then
begin ////
wstawianie(x,w^.prawy,h);
if h then //urosła prawa galaz
case w^.wywaz of
-1: begin
w^.wywaz:=0;
h:=false;
end;
0: w^.wywaz:=1;
1: begin//
p1:=w^.prawy;
if p1^.wywaz=1 then
begin //pojedyncza zamiana pp
w^.prawy:=p1^.lewy;
p1^.lewy:=w;
w^.wywaz:=0;
w:=p1;
end
else
begin // podwojna zamiana PL
p2:=p1^.lewy;
p1^.lewy:=p2^.prawy;
p2^.prawy:=p1;
w^.prawy:=p2^.lewy;
p2^.lewy:=w;
if p2^.wywaz=1 then w^.wywaz:=-1
else w^.wywaz:=0;
if p2^.wywaz=-1 then p1^.wywaz:=1
else p1^.wywaz:=0;
end;
w^.wywaz:=0;
h:=false;
end//
end
end////
else
begin
w^.licznik:=w^.licznik+1;
h:=false;
end;
end;
// drukuj(w);
// Writeln(' ');
END;
/////////////////////////////////////
procedure usun(x:longint;var w:drzewo;var h:boolean);
var
q:drzewo;
procedure wywazanie1(var w:drzewo; var h:boolean);
var
p1,p2 :drzewo;
b1,b2: -1..1;
BEgin
case W^.wywaz of
-1: w^.wywaz:=0;
0: begin
w^.wywaz:=1;
h:=false;
end;
1: begin //wywazanie
p1:=w^.prawy;
b1:=p1^.wywaz;
if b1>=0 then
begin // pojedyncza zamiana
w^.prawy:=p1^.lewy;
p1^.lewy:=w;
if b1=0 then
begin
w^.wywaz:=1;
p1^.wywaz:=-1;
h:=false;
end
else
begin
w^.wywaz:=0;
p1^.wywaz:=0;
end;
w:=p1;
end else
begin // podwojzna zamiana PL
p2:=p1^.lewy;
b2:=p2^.wywaz;
p1^.lewy:=p2^.prawy;
p2^.prawy:=p1;
w^.prawy:=p2^.lewy;
p2^.lewy:=w;
if b2=1 then w^.wywaz:=-1 else w^.wywaz:=0;
if b2=-1 then p1^.wywaz:=1 else p1^.wywaz:=0;
w:=p2;
p2^.wywaz:=0;
end
end
end;
End; // wywazanie 1
procedure wywazanie2(var w:drzewo;var h:boolean);
var
p1,p2:drzewo;
b1,b2: -1..1;
begin
case w^.wywaz of
1: w^.wywaz:=0;
0: begin
w^.wywaz:=-1;
h:=false;
end;
-1: begin // pojedzncya yamiana LL
p1:=w^.lewy;
b1:=p1^.wywaz;
if b1 <= 0 then
begin // pojedyncza zamiana LL
w^.lewy:=p1^.prawy;
p1^.prawy:=w;
if b1=0 then
begin
w^.wywaz:=-1;
p1^.wywaz:=1;
h:=false;
end
else
begin
w^.wywaz:=0;
p1^.wywaz:=0;
end;
w:=p1;
end
else
begin // podwojna zamiana LP
p2:=p1^.prawy;
b2:=p2^.wywaz;
p1^.prawy:=p2^.lewy;
p2^.lewy:=p1;
w^.lewy:=p2^.prawy;
p2^.prawy:=w;
if b2 = -1 then w^.wywaz:=1 else w^.wywaz:=0;
if b2= 1 then p1^.wywaz:=-1 else p1^.wywaz:=0;
w:=p2;
p2^.wywaz:=0;
end
end //
end;
end; // wywazanie 2
procedure usuwanie(var r:drzewo; var h:boolean);
begin
if r^.prawy<>nil then
begin
usuwanie(r^.prawy,h);
if h then wywazanie2(r,h);
end
else
begin
q^.etykieta:=r^.etykieta;
q^.licznik:=r^.licznik;
q:=r;
r:=r^.lewy;
h:=true;
end
end;
Begin // glowna czesc procedury usun
if w = nil then
begin
//Writeln('brak klucza do usuniecia w drzewie');
h:=false;
end
else
if x<w^.etykieta then
begin
usun(x,w^.lewy,h);
if h then wywazanie1(w,h);
end
else
if x>w^.etykieta then
begin
usun(x,w^.prawy,h);
if h then wywazanie2(w,h);
end
else
begin // usun w
q:=w;
if q^.prawy=nil then
begin
w:=q^.lewy;
h:=true;
end
else
if q^.lewy=nil then
begin
w:=q^.prawy;
h:=true;
end
else
begin
usuwanie(q^.lewy,h);
if h then wywazanie1(w,h);
end
//dispose(q)
end;
end;// usun
/////////////////////////////////////
// program glówny
BEGIN
writeln('podaj n');
readln(n);
writeln('podaj zakres');
readln(zakres);
AssignFile(f,'tworzenie.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
AssignFile(f,'przegladanie.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
AssignFile(f,'wyszukiwanie.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
AssignFile(f,'usuwanie.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
AssignFile(f,'dodawanie.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
AssignFile(f,'wysokosc.txt');
Reset(f);
Append(f);
Writeln(F,n,' ');
Close(f);
//repeat
SetLength(B,zakres);
for i:=0 to zakres do B[i]:=1;
SetLength(T,n);
p:=random(zakres)+1;
T[0]:=p;
B[p]:=0;
a:=1;
Setlength(Ba,n);
if zakres>=n then
BEgin
// Writeln('begin');
// Write(T[0],' ');
Repeat
k:=0;
i:=a;
j:=random(zakres);
if B[j]=1 then
Begin
T[a]:=j;
B[j]:=0;
//Write('j ',j,'wartosc = ',B[j]);
// Write(' ',T[a],' ');
a:=a+1;
end;
until (a=(n));
End
Else Writeln('Zly Zakres');
quicksortS(0,n-1);
AssignFile(f,'tworzenie.txt');
Reset(f);
Append(F);
for i:=0 to n-1 do Ba[i]:=T[i];
quicksortS(0,n-1);
writeln(n);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
create(drzewko,0,n-1);
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Write(F,' ',czas,' ');
Writeln(F);
CloseFile(f);
Writeln('czas tworzenia ',czas,' ');
//writeln('drzewko');
//drukuj(drzewko);
AssignFile(f,'wysokosc.txt');
Reset(f);
Append(F);
wysokosc(drzewko,0);
Writeln('wysokosc drzewa ',wys);
Write(F,' ',wys,' ');
Writeln(F);
CloseFile(f);
AssignFile(f,'wyszukiwanie.txt');
Reset(f);
Append(F);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
for i:=0 to ( n div 10) do
begin
elem:=random(zakres);
wyszukiwanie(drzewko);
end;
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas wyszukiwania ',czas);
Write(F,' ',czas,' ');
Writeln(F);
CloseFile(f);
AssignFile(f,'przegladanie.txt');
Reset(f);
Append(F);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
przegladanie(drzewko);
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas przegladanie ',czas);
//Write('po przegladaniu ');
//drukuj(drzewko);
Write(F,' ',czas,' ');
Writeln(F);
CloseFile(f);
//Writeln('po przegladaniu');
//drukuj(drzewko);
drzewko:=nil;
create(drzewko,0,n-1);
//writeln('pierwsze');
// drukuj(drzewko);
AssignFile(f,'dodawanie.txt');
Reset(f);
Append(F);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
for i:=0 to (n div 10) do
begin
elem:=Ba[random(n)];
//writeln('elem ',elem);
h:=false;
wstawianie(elem,drzewko,h);
end;
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas wstawiania ',czas);
// Writeln('po wstawieniu');
// drukuj(drzewko);
Write(F,' ',czas,' ');
Writeln(F);
CloseFile(f);
drzewko:=nil;
create(drzewko,0,n-1);
//writeln('pierwsze');
//drukuj(drzewko);
AssignFile(f,'usuwanie.txt');
Reset(f);
Append(F);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
for i:=0 to (n div 10) do
begin
elem:=random(zakres);
//writeln('elem ',elem);
h:=false;
usun(elem,drzewko,h);
end;
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas usuwania ',czas);
///Writeln('po usunieciu');
//drukuj(drzewko);
Write(F,' ',czas,' ');
Writeln(F);
CloseFile(f);
Setlength(T,0);
Setlength(B,0);
Setlength(Ba,0);
//n:=n+50000;
//readln;
//until n >405000;
End;
BEgin
drzewoAVL;
readln;
end.