program drzew1;
{$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;
B:array of Longint;
tabliczka,zlicz,korzen,m,ile,elem,p,a,j,i,n,z,k,zakres: longint; // zlicz -ilosc wywazen w wstawianiu
dana: TDana; // ile -ilosc wywazen w usuwaniu
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,t[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:=t[(start+stop)div 2];
repeat
while (t[j]>x) do j:=j-1;
while (t[i]<x) do i:=i+1;
if (i<=j)
then
BEgin
h:=t[i];
t[i]:=t[j];
t[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;
zlicz:=zlicz+1;
if p1^.wywaz=-1 then
begin // pojedyncza zamiana LL
w^.lewy:=p1^.prawy;
p1^.prawy:=W;
W^.wywaz:=0;
w:=p1;
zlicz:=zlicz+1;
end
else // podwojna zamiana LP
begin
p2:=p1^.prawy;
p1.prawy:=p2^.lewy;
p2^.lewy:=p1;
w^.lewy:=p2^.prawy;
p2^.prawy:=w;
zlicz:=zlicz+1;
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;
zlicz:=zlicz+1;
if p1^.wywaz=1 then
begin //pojedyncza zamiana pp
w^.prawy:=p1^.lewy;
p1^.lewy:=w;
w^.wywaz:=0;
w:=p1;
zlicz:=zlicz+1;
end
else
begin // podwojna zamiana PL
p2:=p1^.lewy;
p1^.lewy:=p2^.prawy;
p2^.prawy:=p1;
w^.prawy:=p2^.lewy;
p2^.lewy:=w;
zlicz:=zlicz+1;
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 //wywazanie prawe
p1,p2 :drzewo;
b1,b2: -1..1;
BEgin
case W^.wywaz of
-1: w^.wywaz:=0; //jezeli bylo przechylone to teraz jest zrownowazone
0: begin
w^.wywaz:=1;
h:=false;
end;
1: begin
ile:=ile+1;
//writeln('ile',ile);
//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
//writeln('ile ',ile);
ile:=ile+1;
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 // usuwanie dla przypadku gdy wezel posiada 2 synow
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); // usuwanie dwoch synow raz w lewo potem do konca w prawo
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);
zakres:=3000000;
// writeln('ile powtorzen');
// readln(korzen);
AssignFile(F,'drzewa.txt');
reset(F);
append(f);
Writeln(F,'zakres',zakres);
//Rewrite(f);
//Reset(f);
//Append(f);
CloseFile(F);
//korzen:=0;
//repeat
AssignFile(F,'drzewa.txt');
Reset(F);
Append(F);
Writeln(F,'liczba elementow ',n);
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;
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
BEgin
Writeln('Zly Zakres');
readln;
exit;
end;
quicksortS(0,n-1);
//for i:=0 to n-1 do Write(t[i],' ');
writeln;
// writeln(n);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
create(drzewko,0,n-1);
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas tworzenia ',czas,' ');
Writeln(F,'czas tworzenia ',czas:0:2);
//writeln('drzewko');
//drukuj(drzewko);
wysokosc(drzewko,0);
Writeln('wysokosc drzewa ',wys);
Writeln(F,'wysokosc drzewa ',wys);
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
for i:=0 to ( n div 10)-1 do
begin
elem:=random(zakres);
wyszukiwanie(drzewko);
end;
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas wyszukiwania ',czas);
Writeln(F,'czas wyszukiwania ',czas:0:2);
///////////////////////////////////// przegladanie
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
przegladanie(drzewko);
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
Writeln('czas przegladanie ',czas);
Writeln(F,'czas przegladania ',czas:0:2);
//Write('po przegladaniu ');
//drukuj(drzewko);
//drzewko:=nil;
//create(drzewko,0,n-1);
//writeln('pierwsze');
// drukuj(drzewko);
////////////////////////////////////////// wstawianie
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
zlicz:=0;
for i:=0 to (n div 10)-1 do
begin
elem:=random(zakres);
h:=false;
wstawianie(elem,drzewko,h);
end;
QueryPerformanceCounter(TimeEND);
czas:=(TimeEND-Timestart)/Freq*1000;;
//readln;
Writeln('czas wstawiania ',czas);
Writeln(F,'czas wstawiania ',czas:0:2);
writeln('ile wywarzen ',zlicz);
Writeln(F,'ilosc wywazen dodawania ',zlicz);
// Writeln('po wstawieniu');
//// drukuj(drzewko);
// drzewko:=nil;
// create(drzewko,0,n-1);
//writeln('pierwsze');
//drukuj(drzewko);
ile:=0;
if QueryPerformanceFrequency(Freq) then
QueryPerformanceCounter(TimeStart);
for i:=0 to (n div 10)-1 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(F,'czas usuwania ',czas:0:2);
Writeln('ile wywazen usuwania ',ile);
Writeln(F,'ilosc wywazen usuwania ',ile);
Writeln(F);
///Writeln('po usunieciu');
//drukuj(drzewko);
CloseFile(F);
T:=nil;
B:=nil;
drzewko:=nil;
//n:=n+100000;
//readln;
//until korzen=10;
End;
BEgin
drzewoAVL;
readln;
end.