{ 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 Vymenit(pozice1,pozice2:integer;vstup:Tpole;zbarveni:byte); begin setcolor(zbarveni); line(pozice1+1,480-vstup[pozice2],pozice1+1,ymax); setcolor(black); line(pozice1+1,1,pozice1+1,479-vstup[pozice2]); setcolor(zbarveni); line(pozice2+1,480-vstup[pozice1],pozice2+1,ymax); setcolor(black); line(pozice2+1,1,pozice2+1,479-vstup[pozice1]); 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 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=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 levypivot 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=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; readln; end.