Umiestnenie súboru www.TrSek.com/cover/koupy/sorter.pas{ SORTER.PAS Copyright (c) Petr Koupy }
{ }
{ Demonstrace trideni dat. }
{ }
{ Ukázka práce vìt¹iny tøídících algoritmù, které pro tøídìní }
{ pou¾ívají porovnávání dvou prvkù. Program vytvoøí náhodnou }
{ posloupnost èísel, kterou zvoleným algoritmem setøídí. }
{ Jednoduchým benchmarkem je rovnì¾ mo¾né porovnat èasovou slo¾itost}
{ jednotlivých algoritmù. Pro vykreselení grafù je pou¾it jednoduchý}
{ grafický výstup. Program vznikl v rámci pøípravy na maturitu. }
{ }
{ Datum:01.05.2007 http://www.trsek.com }
program sorter;
uses graph,crt,dos;
const xmax=639;
ymax=479;
type Tpole=array[1..xmax] of integer;
Tmalepole=array[1..7] of byte;
var graphdriver,graphmode:smallint;
volba,pocet,k:byte;
fronta:Tmalepole;
ukol,hradlo:boolean;
procedure GenerujPole(var pole:Tpole);
var i:integer;
begin
randomize;
for i:=1 to xmax do pole[i]:=random(ymax-1)+1;
end;
procedure Vyjmout(pozice:integer;vstup:Tpole);
begin
setcolor(black);
line(pozice+1,480-vstup[pozice],pozice+1,ymax);
end;
procedure Vlozit(pozice:integer;vstup:Tpole;zbarveni:byte);
begin
setcolor(zbarveni);
line(pozice+1,480-vstup[pozice],pozice+1,ymax);
setcolor(black);
line(pozice+1,1,pozice+1,479-vstup[pozice]);
end;
procedure InsertionSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
misto,index,prvek,posunuti:integer;
barva:byte;
begin
if ukol=true then barva:=15;
setrideno:=nesetrideno;
for misto:=2 to velikost do
begin
index:=1;
while setrideno[misto]>setrideno[index] do index:=index+1;
prvek:=setrideno[misto];
if ukol=true then Vyjmout(misto,setrideno);
for posunuti:=misto downto index+1 do
begin
if ukol=true then delay(cekat);
setrideno[posunuti]:=setrideno[posunuti-1];
if ukol=true then Vymenit(posunuti,posunuti-1,setrideno,barva);
end;
setrideno[index]:=prvek;
if ukol=true then Vlozit(index,setrideno,barva);
end;
end;
procedure BubbleSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
misto,index,prvek,skok:integer;
barva:byte;
begin
if ukol=true then barva:=9;
setrideno:=nesetrideno;
misto:=velikost;
repeat
begin
skok:=misto-1;
for index:=1 to misto-1 do
begin
if setrideno[index]>setrideno[index+1] then
begin
if ukol=true then delay(cekat);
prvek:=setrideno[index];
if ukol=true then Vymenit(index,index+1,setrideno,barva);
setrideno[index]:=setrideno[index+1];
setrideno[index+1]:=prvek;
skok:=index;
end;
end;
misto:=skok;
end;
until misto<=2;
end;
procedure ShakerSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
index,prvek,skok,dolni,horni:integer;
barva:byte;
smer:boolean;
begin
if ukol=true then barva:=10;
setrideno:=nesetrideno;
horni:=velikost;
dolni:=1;
index:=0;
smer:=true;
skok:=horni;
repeat
begin
repeat
begin
if smer=true then
begin
index:=index+1;
if setrideno[index]>setrideno[index+1] then
begin
if ukol=true then delay(cekat);
prvek:=setrideno[index];
if ukol=true then Vymenit(index,index+1,setrideno,barva);
setrideno[index]:=setrideno[index+1];
setrideno[index+1]:=prvek;
skok:=index;
end
end
else
begin
index:=index-1;
if setrideno[index+1]<setrideno[index] then
begin
if ukol=true then delay(cekat);
prvek:=setrideno[index];
if ukol=true then Vymenit(index,index+1,setrideno,barva);
setrideno[index]:=setrideno[index+1];
setrideno[index+1]:=prvek;
skok:=index+1;
end;
end;
end;
until ((smer=true) and (index+1=horni)) or ((smer=false) and (index=dolni));
if smer=true then
begin
smer:=false;
horni:=skok;
index:=skok;
end
else
begin
smer:=true;
dolni:=skok;
index:=skok-1;
end;
end;
until horni<=dolni;
end;
procedure SelectionSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
misto1,misto2,index,prvek:integer;
barva:byte;
begin
if ukol=true then barva:=11;
setrideno:=nesetrideno;
for misto1:=velikost downto 2 do
begin
if ukol=true then delay(cekat);
index:=1;
for misto2:=1 to misto1 do
begin
if setrideno[misto2]>setrideno[index] then index:=misto2;
end;
prvek:=setrideno[index];
if ukol=true then Vymenit(index,misto1,setrideno,barva);
setrideno[index]:=setrideno[misto1];
setrideno[misto1]:=prvek;
end;
end;
procedure BublejHaldou(velikost,otec:integer;var halda:Tpole;barva,cekat:integer);
var syn,vymena:integer;
begin
while 2*otec<=velikost do
begin
if ukol=true then delay(cekat);
syn:=2*otec;
if (syn<velikost) and (halda[syn]<halda[syn+1]) then syn:=syn+1;
if halda[otec]>=halda[syn] then break;
vymena:=halda[otec];
if ukol=true then Vymenit(otec,syn,halda,barva);
halda[otec]:=halda[syn];
halda[syn]:=vymena;
otec:=syn;
end;
end;
procedure HeapSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
misto,prvek:integer;
barva:byte;
begin
if ukol=true then barva:=12;
setrideno:=nesetrideno;
for misto:=(velikost div 2) downto 1 do BublejHaldou(velikost,misto,setrideno,barva,cekat);
for misto:=velikost downto 2 do
begin
if ukol=true then delay(cekat);
prvek:=setrideno[1];
if ukol=true then Vymenit(1,misto,setrideno,barva);
setrideno[1]:=setrideno[misto];
setrideno[misto]:=prvek;
BublejHaldou(misto-1,1,setrideno,barva,cekat);
end;
end;
procedure MergeSort(var setrideno,pomocne:Tpole;levy,pravy,cekat:integer);
var i,j,k,stred:integer;
barva:byte;
begin
if hradlo=true then
begin
for k:=levy to pravy do pomocne[k]:=setrideno[k];
end;
if ukol=true then barva:=13;
stred:=(levy+pravy) div 2;
if levy<pravy then MergeSort(setrideno,pomocne,levy,stred,cekat);
if stred+1<pravy then MergeSort(setrideno,pomocne,stred+1,pravy,cekat);
i:=levy;
j:=stred+1;
k:=levy;
while (i<=stred) and (j<=pravy) do
begin
if setrideno[i]<=setrideno[j] then
begin
pomocne[k]:=setrideno[i];
if ukol=true then delay(cekat);
if ukol=true then Vymenit(k,i,pomocne,barva);
i:=i+1;
end
else
begin
pomocne[k]:=setrideno[j];
if ukol=true then delay(cekat);
if ukol=true then Vymenit(k,j,pomocne,barva);
j:=j+1;
end;
k:=k+1;
end;
while i<=stred do
begin
pomocne[k]:=setrideno[i];
delay(cekat);
if ukol=true then Vymenit(k,i,pomocne,barva);
i:=i+1;
k:=k+1;
end;
while j<=pravy do
begin
pomocne[k]:=setrideno[j];
if ukol=true then delay(cekat);
if ukol=true then Vymenit(k,j,pomocne,barva);
j:=j+1;
k:=k+1;
end;
for k:=levy to pravy do
begin
setrideno[k]:=pomocne[k];
if ukol=true then delay(cekat);
if ukol=true then Vyjmout(k,setrideno);
if ukol=true then Vlozit(k,setrideno,barva);
end;
end;
procedure QuickSort(var setrideno:Tpole;levy,pravy,cekat:integer);
var i,j,pivot,menic:integer;
barva:byte;
begin
if ukol=true then barva:=14;
i:=levy;
j:=pravy;
pivot:=setrideno[(i+j) div 2];
repeat
begin
while setrideno[i]<pivot do i:=i+1;
while setrideno[j]>pivot do j:=j-1;
if i<=j then
begin
if ukol=true then delay(cekat);
menic:=setrideno[i];
if ukol=true then Vymenit(i,j,setrideno,barva);
setrideno[i]:=setrideno[j];
setrideno[j]:=menic;
i:=i+1;
j:=j-1;
end;
end;
until i>=j;
if j>levy then QuickSort(setrideno,levy,j,cekat);
if i<pravy then QuickSort(setrideno,i,pravy,cekat);
end;
procedure SetridPole(typ:byte);
var polecisel,pomocne:Tpole;
x,prodleva:integer;
begin
repeat
begin
writeln;
write('Prodleva vykreslovani grafu (0 az 100 ms): ');
readln(prodleva);
end;
until (prodleva>=0) and (prodleva<=100);
GenerujPole(polecisel);
detectgraph(graphdriver, graphmode);
initgraph(graphdriver, graphmode, 'C:/TP/BP7/BGI');
setcolor(7);
line(1,1,1,480);
line(1,480,640,480);
case typ of
1: setcolor(15);
2: setcolor(9);
3: setcolor(10);
4: setcolor(11);
5: setcolor(12);
6: setcolor(13);
7: setcolor(14)
end;
hradlo:=true;
for x:=1 to xmax do line(x+1,480-polecisel[x],x+1,ymax);
case typ of
1: InsertionSort(xmax,polecisel,prodleva);
2: BubbleSort(xmax,polecisel,prodleva);
3: ShakerSort(xmax,polecisel,prodleva);
4: SelectionSort(xmax,polecisel,prodleva);
5: HeapSort(xmax,polecisel,prodleva);
6: MergeSort(polecisel,pomocne,1,xmax,prodleva);
7: QuickSort(polecisel,1,xmax,prodleva)
end;
end;
procedure SpocitejGraf(opakovani:byte;seznam:Tmalepole);
var opakuj:byte;
balon,pomocne:Tpole;
s1,s2,v1,v2,m1,m2,h1,h2:word;
cas1,cas2:longint;
zaplneni,n:integer;
begin
randomize;
detectgraph(graphdriver, graphmode);
initgraph(graphdriver, graphmode, 'C:/TP/BP7/BGI');
setcolor(7);
line(1,1,1,480);
line(1,480,640,480);
GenerujPole(balon);
for opakuj:=1 to opakovani do
begin
zaplneni:=2;
cas2:=0;
n:=0;
repeat
begin
gettime(h1,m1,v1,s1);
case seznam[opakuj] of
1: for n:=1 to 10000 do
begin
InsertionSort(zaplneni,balon,0);
n:=n+1;
end;
2: for n:=1 to 10000 do
begin
BubbleSort(zaplneni,balon,0);
n:=n+1;
end;
3: for n:=1 to 10000 do
begin
ShakerSort(zaplneni,balon,0);
n:=n+1;
end;
4: for n:=1 to 10000 do
begin
SelectionSort(zaplneni,balon,0);
n:=n+1;
end;
5: for n:=1 to 10000 do
begin
HeapSort(zaplneni,balon,0);
n:=n+1;
end;
6: for n:=1 to 10000 do
begin
MergeSort(balon,pomocne,1,zaplneni,0);
n:=n+1;
end;
7: for n:=1 to 10000 do
begin
QuickSort(balon,1,zaplneni,0);
n:=n+1;
end
end;
gettime(h2,m2,v2,s2);
cas1:=cas2;
cas2:=(h2*60*60*100+m2*60*100+v2*100+s2)-(h1*60*60*100+m1*60*100+v1*100+s1);
case seznam[opakuj] of
1: setcolor(15);
2: setcolor(9);
3: setcolor(10);
4: setcolor(11);
5: setcolor(12);
6: setcolor(13);
7: setcolor(14)
end;
line(4*zaplneni+1-4,479-(6*cas1),4*zaplneni+1,479-(6*cas2));
zaplneni:=zaplneni+1;
end;
until zaplneni>=160;
end;
end;
begin
clrscr;
writeln('SORTER - demonstrace trideni dat');
writeln('Copyright (c) 2007 Petr Koupy');
repeat
begin
writeln;
writeln('Co chcete provest?');
writeln('(1) Setridit vygenerovane pole');
writeln('(2) Zobrazit graf casove slozitosti');
write('Volba: ');
readln(volba);
end;
until (volba=1) or (volba=2);
if volba=1 then
begin
ukol:=true;
writeln;
writeln('Jaky tridici algoritmus chcete pouzit?');
textcolor(15); writeln('(1) InsertionSort');
textcolor(9); writeln('(2) BubbleSort');
textcolor(10); writeln('(3) ShakerSort');
textcolor(11); writeln('(4) SelectionSort');
textcolor(12); writeln('(5) HeapSort');
textcolor(13); writeln('(6) MergeSort');
textcolor(14); writeln('(7) QuickSort');
repeat
begin
textcolor(7); write('Volba: ');
readln(volba);
end;
until (volba>=1) and (volba<=7);
SetridPole(volba);
end
else
begin
ukol:=false;
repeat
begin
writeln;
writeln('Kolik algoritmu chcete propocitat (1 az 7)?');
write('Pocet: ');
readln(pocet);
end;
until (pocet>=1) and (pocet<=7);
writeln;
writeln('Jaky tridici algoritmus chcete zaradit do fronty?');
textcolor(15); writeln('(1) InsertionSort');
textcolor(9); writeln('(2) BubbleSort');
textcolor(10); writeln('(3) ShakerSort');
textcolor(11); writeln('(4) SelectionSort');
textcolor(12); writeln('(5) HeapSort');
textcolor(13); writeln('(6) MergeSort');
textcolor(14); writeln('(7) QuickSort');
textcolor(7);
for k:=1 to pocet do
begin
repeat
begin
write('Volba ',k,'. mista fronty: ');
readln(fronta[k]);
end;
until (fronta[k]>=1) and (fronta[k]<=7);
end;
SpocitejGraf(pocet,fronta);
end;