W celu porównania szybkości działania poszczególnych algorytmów sortujących zmierzymy czasy sortowania tego samego zbioru 10000 liczb całkowitych 64-bitowych. Otrzymane wyniki są jedynie orientacyjne - dla innych danych możemy otrzymać nieco inną kolejność poszczególnych algorytmów. Dlatego zachęcamy czytelnika do eksperymentów na różnych zbiorach danych (zbudowanych z różnych obiektów - liczb rzeczywistych, łańcuchów znakowych, itp.).
Pomiarów dokonaliśmy w systemie komputerowym wyposażonym w procesor Intel Celeron 1,7GHz, pamięć 512 MB RAM z wyłączoną obsługą sieci oraz z zamkniętymi wszelkimi, nieistotnymi dla pracy systemu procesami (jest to bardzo ważne, ponieważ procesy pracujące w tle wpływają dosyć istotnie na otrzymywane wyniki). Program testowy był następujący:
// Program wyznaczający kolejność algorytmów sortujących
// wg czasu sortowania zbioru 10000 liczb naturalnych
// w warunkach kontrolowanego uruchomienia
//--------------------------------------
// (C)2005 mgr Jerzy Wałaszek
// I Liceum Ogólnokształcące
// w Tarnowie
//--------------------------------------
program KolAlgSort;
uses Windows;
const
N = 10000; // Ilość sortowanych elementów
WMIN = 0; // Wartość minimalna elementów
WMAX = 10000; // Wartość maksymalna elementów
type
TElement = record
nastepnik : cardinal;
dane : int64;
end;
TZbior = array[1..N] of int64;
var
b,d,e : array[1..N] of int64;
qpf,tqpc : int64;
qpc1,qpc2 : int64;
// Poszczególne algorytmy sortujące
procedure StupidSort;
var
i : integer;
x : int64;
begin
i := 1;
repeat
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
i := 1;
continue;
end;
inc(i);
until i = N;
end;
//---------------------------------------------
procedure BubbleSort1;
var
i,j : integer;
x : int64;
begin
for j := 1 to N - 1 do
for i := 1 to N - 1 do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
end;
end;
//---------------------------------------------
procedure BubbleSort2;
var
i,j : integer;
x : int64;
begin
for j := N - 1 downto 1 do
for i := 1 to j do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
end;
end;
//---------------------------------------------
procedure BubbleSort3;
var
i,j,p : integer;
x : int64;
begin
for j := N - 1 downto 1 do
begin
p := 1;
for i := 1 to j do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
p := 0;
end;
if p = 1 then break;
end;
end;
//---------------------------------------------
procedure BubbleSort4;
var
i,p,pmin,pmax : integer;
x : int64;
begin
pmin := 1; pmax := N - 1;
repeat
p := 0;
for i := pmin to pmax do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
if p = 0 then pmin := i;
p := i;
end;
if pmin > 1 then dec(pmin);
pmax := p - 1;
until p = 0;
end;
//---------------------------------------------
procedure BidirectionalBubbleSort;
var
i,p,pmin,pmax : integer;
x : int64;
begin
pmin := 1; pmax := N - 1;
repeat
p := 0;
for i := pmin to pmax do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
p := i;
end;
if p = 0 then break;
pmax := p - 1;
p := 0;
for i := pmax downto pmin do
if d[i] > d[i + 1] then
begin
x := d[i]; d[i] := d[i + 1]; d[i + 1] := x;
p := i;
end;
pmin := p + 1;
until p = 0;
end;
//---------------------------------------------
procedure SelectionSort;
var
i,j,pmin : integer;
x : int64;
begin
for j := 1 to N - 1 do
begin
pmin := j;
for i := j + 1 to N do
if d[i] < d[pmin] then pmin := i;
x := d[pmin]; d[pmin] := d[j]; d[j] := x;
end;
end;
//---------------------------------------------
procedure InsertionSort;
var
i,j : integer;
x : int64;
begin
for j := N - 1 downto 1 do
begin
x := d[j];
i := j + 1;
while (i <= N) and (x > d[i]) do
begin
d[i - 1] := d[i];
inc(i);
end;
d[i - 1] := x;
end;
end;
//---------------------------------------------
procedure BinaryInsertionSort;
var
i,j,ip,ik : integer;
x : int64;
begin
for j := N - 1 downto 1 do
begin
x := d[j];
ip := j;
ik := N + 1;
while ik - ip > 1 do
begin
i := (ik + ip) div 2;
if x <= d[i] then ik := i else ip := i;
end;
for i := j to ip - 1 do d[i] := d[i + 1];
d[ip] := x;
end;
end;
//---------------------------------------------
procedure ShellSort;
var
i,j,h : integer;
x : int64;
begin
h := 1;
repeat
h := 3 * h + 1;
until h >= N;
h := (h div 9);
while(h > 0) do
begin
for j := N - h downto 1 do
begin
x := d[j];
i := j + h;
while (i <= N) and (x > d[i]) do
begin
d[i - h] := d[i];
i += h;
end;
d[i - h] := x;
end;
h := h div 3;
end;
end;
//---------------------------------------------
procedure MergeSort(i_p,i_k : integer);
var
i_s,i1,i2,i : integer;
begin
i_s := (i_p + i_k + 1) div 2;
if i_s - i_p > 1 then MergeSort(i_p, i_s - 1);
if i_k - i_s > 0 then MergeSort(i_s, i_k);
i1 := i_p; i2 := i_s;
for i := i_p to i_k do
if (i1 = i_s) or ((i2 <= i_k) and (d[i1] > d[i2])) then
begin
b[i] := d[i2]; inc(i2);
end
else
begin
b[i] := d[i1]; inc(i1);
end;
for i := i_p to i_k do d[i] := b[i];
end;
//---------------------------------------------
procedure HeapSort;
var
i,j,k,m : integer;
x : int64;
begin
for i := 2 to N do
begin
j := i; k := j div 2;
x := d[i];
while (k > 0) and (d[k] < x) do
begin
d[j] := d[k];
j := k; k := j div 2;
end;
d[j] := x;
end;
for i := N downto 2 do
begin
x := d[1]; d[1] := d[i]; d[i] := x;
j := 1; k := 2;
while k < i do
begin
if (k + 1 < i) and (d[k + 1] > d[k]) then
m := k + 1
else
m := k;
if d[m] <= d[j] then break;
x := d[j]; d[j] := d[m]; d[m] := x;
j := m; k := j + j;
end;
end;
end;
//---------------------------------------------
procedure QuickSort(lewy, prawy : integer);
var
i,j : integer;
piwot,x : int64;
begin
i := (lewy + prawy) div 2;
piwot := d[i]; d[i] := d[prawy];
j := lewy;
for i := lewy to prawy - 1 do
if d[i] < piwot then
begin
x := d[i]; d[i] := d[j]; d[j] := x;
inc(j);
end;
d[prawy] := d[j]; d[j] := piwot;
if lewy < j - 1 then QuickSort(lewy, j - 1);
if j + 1 < prawy then QuickSort(j + 1, prawy);
end;
//---------------------------------------------
procedure BucketSort1;
var
lw : array[WMIN..WMAX] of integer;
i,j : integer;
begin
for i := WMIN to WMAX do lw[i] := 0;
for i := 1 to N do inc(lw[d[i]]);
j := 1;
for i := WMIN to WMAX do
while lw[i] > 0 do
begin
d[j] := i; inc(j); dec(lw[i]);
end;
end;
//---------------------------------------------
procedure BucketSort2;
var
L : array[1..N] of TElement;
K : array[WMIN..WMAX] of integer;
we : int64;
ine,ip,ib,i,j : integer;
begin
for i := WMIN to WMAX do K[i] := 0;
ine := 1;
for i := 1 to N do
begin
we := d[i];
L[ine].nastepnik := 0; L[ine].dane := we;
ip := 0; ib := K[we];
while (ib > 0) and (L[ib].dane < we) do
begin
ip := ib; ib := L[ib].nastepnik;
end;
if ip = 0 then
begin
L[ine].nastepnik := ib; K[we] := ine
end
else if ib = 0 then
L[ip].nastepnik := ine
else
begin
L[ip].nastepnik := ine; L[ine].nastepnik := ib;
end;
inc(ine);
end;
j := 1;
for ib := WMIN to WMAX do
begin
i := K[ib];
while i > 0 do
begin
d[j] := L[i].dane;
inc(j); i := L[i].nastepnik;
end;
end;
end;
//---------------------------------------------
procedure CountingSort;
var
L : array[WMIN..WMAX] of cardinal;
i : integer;
begin
for i := WMIN to WMAX do L[i] := 0;
for i := 1 to N do inc(L[d[i]]);
for i := WMIN + 1 to WMAX do L[i] += L[i - 1];
for i := N downto 1 do
begin
b[L[d[i]]] := d[i]; dec(L[d[i]]);
end;
end;
//---------------------------------------------
procedure SortujBit(var z1,z2 : TZbior; m : int64);
var
L : array[boolean] of cardinal;
i : cardinal;
t : boolean;
begin
L[false] := 0; L[true] := 0;
for i := 1 to N do inc(L[(z1[i] and m) > 0]);
L[true] += L[false];
for i := N downto 1 do
begin
t := (z1[i] and m) > 0;
z2[L[t]] := z1[i];
dec(L[t]);
end;
end;
procedure RadixSort;
var
m : int64;
begin
m := 1;
while m <= WMAX do
begin
SortujBit(d,b,m); m := m shl 1;
SortujBit(b,d,m); m := m shl 1;
end;
end;
// Funkcja pomiaru czasu sortowania
function Sort(nr : integer) : extended;
begin
QueryPerformanceCounter(addr(qpc1));
case nr of
1 : StupidSort;
2 : BubbleSort1;
3 : BubbleSort2;
4 : BubbleSort3;
5 : BubbleSort4;
6 : BidirectionalBubbleSort;
7 : SelectionSort;
8 : InsertionSort;
9 : BinaryInsertionSort;
10 : ShellSort;
11 : MergeSort(1,N);
12 : HeapSort;
13 : QuickSort(1,N);
14 : BucketSort1;
15 : BucketSort2;
16 : CountingSort;
17 : RadixSort;
end;
QueryPerformanceCounter(addr(qpc2));
Sort := (qpc2 - qpc1 - tqpc) / qpf;
end;
// Program główny
//---------------
const
NazwaAlgorytmu : array[1..17] of string =
('Stupid Sort','Bubble Sort I','Bubble Sort II','Bubble Sort III',
'Bubble Sort IV','Bidirectional Bubble Sort','Selection Sort',
'Insertion Sort','Binary Insertion Sort','Shell Sort','Merge Sort',
'Heap Sort','Quick Sort','Bucket Sort I','Bucket Sort II',
'Counting Sort','Radix Sort');
type
TAlgorytm = record
nazwa : string;
czas : extended;
end;
var
algorytm : array[1..18] of TAlgorytm;
i,j : integer;
f : Text;
begin
writeln('Porownanie czasu sortowania wybranych algorytmow');
writeln('------------------------------------------------');
writeln('(C)2005 mgr Jerzy Walaszek I LO w Tarnowie');
writeln;
if QueryPerformanceFrequency(addr(qpf)) then
begin
QueryPerformanceCounter(addr(qpc1));
QueryPerformanceCounter(addr(qpc2));
tqpc := qpc2 - qpc1;
assignfile(f,'wyniki.txt'); rewrite(f);
writeln(f,'Porownanie czasu sortowania wybranych algorytmow');
writeln(f,'------------------------------------------------');
writeln(f,'(C)2005 mgr Jerzy Walaszek I LO w Tarnowie');
writeln(f,'');
randomize;
for i := 1 to N do e[i] := random(WMAX + 1);
for i := 1 to 17 do
with algorytm[i] do
begin
d := e;
nazwa := NazwaAlgorytmu[i];
czas := Sort(i);
writeln(czas:11:6,' : ',nazwa);
writeln(f,czas:11:6,' : ',nazwa);
end;
for j := 16 downto 1 do
begin
algorytm[18] := algorytm[j];
i := j + 1;
while (i <= 17) and (algorytm[18].czas > algorytm[i].czas) do
begin
algorytm[i - 1] := algorytm[i];
inc(i);
end;
algorytm[i - 1] := algorytm[18];
end;
writeln;
writeln('Ranking:');
writeln;
writeln(f,'');
writeln(f,'Ranking:');
writeln(f,'');
for i := 1 to 17 do
begin
writeln(i:2,'. ',algorytm[i].czas:11:6,' - ',algorytm[i].nazwa);
writeln(f,i:2,'. ',algorytm[i].czas:11:6,' - ',algorytm[i].nazwa);
end;
CloseFile(f);
end
else
writeln('Na tym komputerze nie mozna wykonac pomiaru!');
writeln;
writeln('Koniec - nacisnij ENTER');
readln;
end.
Efekt działania tego programu jest następujący:
Porownanie czasu sortowania wybranych algorytmow
------------------------------------------------
(C)2005 mgr Jerzy Walaszek I LO w Tarnowie
595.809227 : Stupid Sort
1.274373 : Bubble Sort I
0.940440 : Bubble Sort II
0.917117 : Bubble Sort III
0.936409 : Bubble Sort IV
0.674173 : Bidirectional Bubble Sort
0.369731 : Selection Sort
0.295610 : Insertion Sort
0.274226 : Binary Insertion Sort
0.004668 : Shell Sort
0.004436 : Merge Sort
0.005149 : Heap Sort
0.002832 : Quick Sort
0.000594 : Bucket Sort I
0.001588 : Bucket Sort II
0.000788 : Counting Sort
0.007603 : Radix Sort
Ranking:
1. 0.000594 - Bucket Sort I
2. 0.000788 - Counting Sort
3. 0.001588 - Bucket Sort II
4. 0.002832 - Quick Sort
5. 0.004436 - Merge Sort
6. 0.004668 - Shell Sort
7. 0.005149 - Heap Sort
8. 0.007603 - Radix Sort
9. 0.274226 - Binary Insertion Sort
10. 0.295610 - Insertion Sort
11. 0.369731 - Selection Sort
12. 0.674173 - Bidirectional Bubble Sort
13. 0.917117 - Bubble Sort III
14. 0.936409 - Bubble Sort IV
15. 0.940440 - Bubble Sort II
16. 1.274373 - Bubble Sort I
17. 595.809227 - Stupid Sort
Konkurs szybkości sortowania wygrywają algorytmy sortowania dystrybucyjnego - jest to dosyć oczywiste, ponieważ mają one liniową klasę złożoności obliczeniowej. Z algorytmów porównujących klasy liniowo logarytmicznej na pierwszej pozycji wyłania się algorytm sortowania szybkiego. Z algorytmów klasy kwadratowej pierwsze miejsce zajął algorytm binarnego sortowania przez wstawianie. Tuż za nim jest algorytm sortowania przez wstawianie. Algorytmy sortowania bąbelkowego zamykają naszą listę. Algorytm sortowania naiwnego jest daleko, daleko w tyle.
Najszybsze algorytmy sortujące to algorytmy sortowania dystrybucyjnego. Jednakże szybkość ich działania jest okupiona dużym zapotrzebowaniem na pamięć. Algorytmy te mają liniową klasę czasowej złożoności obliczeniowej.
Z algorytmów sortujących w miejscu najszybszym w typowych warunkach jest algorytm sortowania szybkiego. Posiada liniowo logarytmiczną klasę czasowej złożoności obliczeniowej. Jednakże dla niekorzystnych danych może się degradować do klasy kwadratowej.
Wolniejszym (około dwa razy) algorytmem sortowania klasy liniowo logarytmicznej jest algorytm sortowania stogowego. Algorytm ten nie degraduje się do niższej klasy złożoności obliczeniowej i może być alternatywą dla algorytmu sortowania szybkiego.
Bardzo obiecujące wyniki otrzymaliśmy dla algorytmu sortowania metodą Shella.
W klasie kwadratowej złożoności obliczeniowej zalecany jest do stosowania algorytm sortowania przez wstawianie. Jest bardzo prosty w implementacji i jednocześnie wystarczająco szybki. Dla zbiorów w znacznym stopniu uporządkowanych wykazuje liniową klasę złożoności obliczeniowej. Dlatego nadaje się np. do sortowania zbioru uporządkowanego, do którego dodajemy nowy element - zbiór będzie posortowany szybciej niż przez algorytm sortowania szybkiego (porównaj czasy tpp i tpk dla 32000 elementów). Ten wniosek jasno pokazuje, iż nie ma uniwersalnych algorytmów sortujących.
Algorytmów sortowania bąbelkowego raczej należy unikać.
n!)
)
tod 
