snaut
Nowicjusz
- Dołączył
- 1 Sierpień 2005
- Posty
- 493
- Punkty reakcji
- 1
- Wiek
- 17
Z sortowaniem zmaga się każdy, nie raz. Już jakiś czas temu napisełem program którego głównym zadaniem jest porównanie wydajności poszczególnyh algorytmów. Chciałbym wystawić go tutaj na ocenę i ewentualne poprawki. W programi miało być jeszcze bubblesort ale już po prostu mi się go nie chciało implementować. Jakby ktoś miał jakieś uwagi do implementacji poszczególnych algorytmów to w tym topicu mógłby to zrobić. Byłbym za to wdzięczny. Może też poniższy kod komuś się przyda, bo u mnie odkąd turbo pascalem się nie zajmuję zajmował tylko miejsce na dysku. Jest tego kodu trochę, ale i tak interfejs nie należy do genialnych, ale nie to przecież jest najważniejsze.
Kod:
program Sortowanie;
uses CRT , DOS;
{---------------------------------------------------------------------------}
const
ilosc=3500;
type
tablica=array[1..ilosc] of integer;
tab1=array[1..8] of longint;
var
t1:tablica;
S:tab1;
f:integer;
start,stop,caly:longint;
LicznikPorownan,LicznikZamian,LiczbaPowtorzen:longint;
{---------------------------------------------------------------------------}
procedure info(alg:string; lp , cs:longint);
begin
writeln('Podczas wykonania algorytmu ',alg,' nastapilo:');
writeln('Porownan:',lp);
writeln('Czas dzialania algorytmu to: ', cs , ' setnych sekundy');
end;
procedure statystyka;
var
i:integer;
begin
writeln;
writeln('Porownanie roznych algorytmow sortowania');
write(#218);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#194);
end
else
begin
write(#196);
end;
end;
write(#191);
writeln;
writeln(#179,' ',#179,' Czas ',#179,' Liczba ',#179);
writeln(#179,' ',#179,' sortowania ',#179,' porownan ',#179);
write(#195);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#197);
end
else
begin
write(#196);
end;
end;
write(#180);
writeln;
writeln(#179,'Bubblesort',#179,S[1]:13,#179,S[2]:13,#179);
write(#195);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#197);
end
else
begin
write(#196);
end;
end;
write(#180);
writeln;
writeln(#179,'Heapsort ',#179,S[3]:13,#179,S[4]:13,#179);
write(#195);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#197);
end
else
begin
write(#196);
end;
end;
write(#180);
writeln;
writeln(#179,'Mergesort ',#179,S[5]:13,#179,S[6]:13,#179);
write(#195);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#197);
end
else
begin
write(#196);
end;
end;
write(#180);
writeln;
writeln(#179,'Quicksort ',#179,S[7]:13,#179,S[8]:13,#179);
write(#192);
for i:=1 to 38 do
begin
if((i=11) or (i=25)) then
begin
write(#193);
end
else
begin
write(#196);
end;
end;
write(#217);
end;
procedure czas(var q:longint);
var
H,M,S,St:word;
begin
GetTime( H , M , S , St );
q:=( (H*60 + M) * 60 + S ) * 100 + St;
end;
procedure losuj(var tab:tablica);
var
i:integer;
begin
for i:=1 to ilosc do
tab[i]:=random(900);
end;
procedure wyswietl(tab:tablica);
var
i:integer;
begin
for i:=1 to ilosc do
write(tab[i]:5);
end;
{---------------------------------------------------------------------------}
{Sortownaie przez kopcowanie}
procedure przywroc(rod,LiczbaElementow:integer; var tab:tablica);
var
pot, z:integer;
begin
while( rod <= LiczbaElementow div 2 ) do
begin
pot:=2 * rod;
if( ( pot < LiczbaElementow ) and ( tab[pot] < tab[pot+1] ) ) then
pot:=pot+1;
if( tab[rod] >= tab[pot] ) then
begin
LicznikPorownan:=LicznikPorownan+3;
break;
end
else
begin
z:=tab[rod];
tab[rod]:=tab[pot];
tab[pot]:=z;
rod:=pot;
end;
LicznikPorownan:=LicznikPorownan+3;
end;
end;
procedure heapsort(var tab:tablica);
var
k, z:integer;
begin
for k:=ilosc div 2 downto 1 do
begin
przywroc( k , ilosc , tab );
LicznikPorownan:=LicznikPorownan+1;
end;
k:=ilosc;
while k >= 3 do
begin
z:=tab[1];
tab[1]:=tab[k];
tab[k]:=z;
k:=k - 1;
przywroc( 1 , k , tab );
LicznikPorownan:=LicznikPorownan+1;
end;
z:=tab[2];
tab[2]:=tab[1];
tab[1]:=z;
end;
procedure heapsort1(tab:tablica);
begin
heapsort(tab);
end;
{---------------------------------------------------------------------------}
{Sortowanie szybkie}
procedure quicksort(x,y:integer; var t:tablica);
var j,k,l,z,wyr:integer;
begin
k:=x;
j:=y;
wyr:=t[(x+y) div 2];
repeat
while t[k]<wyr do
begin
LicznikPorownan:=LicznikPorownan + 1;
k:=k+1;
end;
while t[j]>wyr do
begin
j:=j-1;
LicznikPorownan:=LicznikPorownan + 1;
end;
if k<=j then
begin
LicznikPorownan:=LicznikPorownan + 1;
z:=t[j];
t[j]:=t[k];
t[k]:=z;
k:=k + 1;
j:=j - 1;
end;
LicznikPorownan:=LicznikPorownan + 1;
until k > j;
if k < y then
begin
LicznikPorownan:=LicznikPorownan + 1;
quicksort( k , y , t );
end;
if x < j then
begin
LicznikPorownan:=LicznikPorownan + 1;
quicksort( x , j , t );
end;
end;
procedure quicksort1( k:tablica );
begin
quicksort( 1 , ilosc , k );
end;
{---------------------------------------------------------------------------}
{Sortowanie babelkowe}
{---------------------------------------------------------------------------}
{Sortowanie przez scalanie}
procedure kopiuj(skad:tablica; var dokad:tablica; p,k:integer);
begin
for p:=p to k do
begin
dokad[p]:=skad[p];
LicznikPorownan:=LicznikPorownan+1;
end;
end;
procedure scal(var t:tablica; pocz,sr,kon:integer);
var
buf:tablica;
p1,k1,p2,k2,l:integer;
begin
p1:=pocz;
k1:=sr;
p2:=k1+1;
k2:=kon;
l:=p1;
while( ( p1 <= k1 ) and ( p2 <= k2 ) ) do
begin
if( t[p1] < t[p2] ) then
begin
buf[l]:=t[p1];
p1:=p1 + 1;
end
else
begin
buf[l]:=t[p2];
p2:=p2 + 1;
end;
l:=l + 1;
LicznikPorownan:=LicznikPorownan+2;
end;
while( p1 <= k1 ) do
begin
buf[l]:=t[p1];
p1:=p1 + 1;
l:=l + 1;
LicznikPorownan:=LicznikPorownan+1;
end;
while(p2 <= k2) do
begin
buf[l]:=t[p2];
p2:=p2 + 1;
l:=l + 1;
LicznikPorownan:=LicznikPorownan+1;
end;
for p1:=pocz to kon do
begin
t[p1]:=buf[p1];
LicznikPorownan:=LicznikPorownan+1;
end;
end;
procedure mergesort (var t:tablica; p,k:integer);
var
mid:integer;
begin
LicznikPorownan:=LicznikPorownan+1;
if(p < k) then
begin
mid:=( p + k ) div 2;
mergesort( t , p , mid );
mergesort( t , mid+1 , k );
scal( t , p , mid , k );
end;
end;
procedure mergesort1(t:tablica; p,k:integer);
begin
mergesort( t , p , k );
end;
{---------------------------------------------------------------------------}
begin
clrscr;
LicznikPorownan:=0;
LicznikZamian:=0;
LiczbaPowtorzen:=10;
writeln('Program porownujacy czas dzialania algorytmow sortowania');
writeln;
randomize;
losuj( t1 );
LiczbaPowtorzen:=100;
writeln('Nacisnij enter, aby rozpaczac sortowanie przez kopcowanie');
readln;
czas(start);
for f:=1 to LiczbaPowtorzen do
heapsort1( t1 );
czas(stop);
caly:=stop-start;
S[3]:=caly;
S[4]:=LicznikPorownan;
writeln('Gotowe!');
info('sortowanie przez kopcowanie',LicznikPorownan,caly);
writeln;
LicznikPorownan:=0;
caly:=0;
writeln('Nacisnij enter, aby rozpaczac sortowanie szybkie');
readln;
czas(start);
for f:=1 to LiczbaPowtorzen do
quicksort1( t1 );
czas(stop);
caly:= stop - start;
S[7]:=caly;
S[8]:=LicznikPorownan;
writeln('Gotowe!');
info('quicksort',LicznikPorownan,caly);
writeln;
start:=0;
stop:=0;
writeln('Nacisnij enter, aby rozpaczac sortowanie przez scalanie');
readln;
czas(start);
for f:=1 to LiczbaPowtorzen do
mergesort1( t1 , 1 , ilosc);
czas(stop);
caly:=stop - start;
S[5]:=caly;
S[6]:=LicznikPorownan;
writeln('Gotowe!');
info('sortowanie przez scalanie',LicznikPorownan,caly);
writeln;
statystyka;
writeln;
writeln('Nacisnij dowolny przycisk, aby zakonczyc');
repeat until keypressed;
end.