Insert-sort, Bubble-sort, Shaker-sort, sheLL-sort, Quick-sort, Dobosiewicz-sort, Merge-sort, Tree-sort, Heap-sort, maX-sort v pascale
Delphi & Pascal (èeská wiki)
Kategórie: KMP (Programy mladých programátorù)
Autor: Ján Benkoviè
web: www.tbteacher.host.sk
Program: Sortiada.pas
Soubor exe: Sortiada.exe
Autor: Ján Benkovièweb: www.tbteacher.host.sk
Program: Sortiada.pas
Soubor exe: Sortiada.exe
Program na demon¹trovanie triediacich algoritmov. Naprogramované sú nasledovné algoritmy
- Insert-sort
- Bubble-sort
- Shaker-sort
- sheLL-sort
- Quick-sort
- Dobosiewicz-sort
- Merge-sort
- Tree-sort
- Heap-sort
- maX-sort
- Insert-sort
- Bubble-sort
- Shaker-sort
- sheLL-sort
- Quick-sort
- Dobosiewicz-sort
- Merge-sort
- Tree-sort
- Heap-sort
- maX-sort
{ SORTIADA.PAS } { Program na demonstrovanie triediacich algoritmov. } { Naprogramovane su nasledovne algoritmy: } { - Insert-sort } { - Bubble-sort } { - Shaker-sort } { - sheLL-sort } { - Quick-sort } { - Dobosiewicz-sort } { - Merge-sort } { - Tree-sort } { - Heap-sort } { - maX-sort } { } { Datum:11.11.2002 http://www.trsek.com } program shoW_okienko; { T R I E D I A C E A L G O R I T M Y ===================================== .......... jednoduch‚ demonstracne prostredie .......... ulohy : a) Vymysli a implementuj in£ tematiku b) Dopln dalsie algoritmy c) Nech viacero algoritmov be‘¡ na obrazovke s£‡asne d) V pr¡pade ' iba €as ' naprogramuj meranie ‡asu e) Dopl¤ syst‚m help .............................................................. } uses dos,crt,graph; const cesta_bgi =''; meno_dat_suboru : string = 'sort.dat'; x0 = 50; y0 = 2; poc_max = 80; {.. po‡et textov .} {.. implicitn‚ t.j. default nastavenia .} zac_main : integer = 21; { hlavne menu .} kon_main : integer = 27; cislo_submenu : integer = 22; { = vyber algoritmus .} zac_a : integer = 1; { submenu algoritmy .} kon_a : integer = 10; c_sortu : integer = 2; { = bubblesort .} zac_r : integer = 39; { submenu rozsah .} kon_r : integer = 51; rozsah : integer = 42; { = n..30 .} n : integer = 30; zac_char : integer = 34; { submenu char. dat .} kon_char : integer = 38; typ_dat : integer = 36; { = n hodne .. .} zac_p : integer = 63; { submenu palicka/bod .} kon_p : integer = 64; palicky_body : integer = 63; { = palicky .} palica = 63; bodka = 64; zac_t : integer = 67; { submenu tempo } kon_t : integer = 72; tempo : integer = 68; { = ‡akanie } tempo_spomal : integer = 68; cakanie : integer = 100; c_tempa : integer = 1; temp : integer = 1; etapy_stop : boolean = false; cyklus_stop : boolean = false; cyklus_vnutri : boolean = false; krok_stop : boolean = false; cakaj : boolean = true; esc : boolean = false; zac_d : integer = 76; { submenu spomalenie } kon_d : integer = 80; spomalenie : integer = 78; { = delay kon¨t = 100ms } dole = 'P'; hore = 'H'; {.. druh˜ byte pre ¨ipky .} {.. vtedy je prv˜ = #0 .} te : array[0..6] of string[11] = (' Nestoj ',' Delay 100 ' ,' Etapy ',' Cyklus ' ,' Vnutri ',' Krokom ' ,' Esc '); vyska : integer = 10; { pre Herc smallfont } sirka : integer = 8; type texty = array[1..poc_max] of string[21]; {.. texty pre menu a submenu .} const t : texty = (' Insert-sort '{..... 1........... } ,' Bubble-sort ' ,' Shaker-sort '{.. v˜ber algoritmu.} ,' sheLL-sort ' ,' Quick-sort ' ,' Dobosiewicz-sort ' {6} ,' Merge-sort ' {7} ,' Tree-sort ' ,' Heap-sort ' ,' maX-sort ' {10} ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' Tempo uk ‘ky ' {...... 21........ } ,' Algoritmus ' {...... 22........ } ,' nastav Rozsah pola ' ,' Charakter £dajov ' {== hlavn‚ menu == } ,' Pali‡ky/bodky/ni‡ ' ,' Vykonaj ' ,' Quit ' {...... 27........ } ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' Vzostupne ' {...... 34........ } ,' Zostupne ' ,' N hodne ' {=== typ dat ===} ,' Rovnak‚ ' ,' S£bor ' {...... 38 ........} ,' n = 10 ' {...... 39 ........} ,' n = 20 ' ,' n = 30 ' {=== rozsah ===} ,' n = 40 ' ,' n = 50 ' ,' n = 70 ' ,' n = 100 ' ,' n = 200 ' ,' n = 300 ' ,' n = 400 ' ,' n = 500 ' ,' n = 700 ' ,' n = 1000 ' { 51 } ,' n = 2000 ' ,' n = 3000 ' ,' n = 4000 ' ,' n = 5000 ' ,' n = 10000 ' {.... 56........ } ,' ' ,' ' ,' ' ,' ' ,' ' ,' ' ,' Palicky ' {.... 63........ } ,' Bodky ' {== tvar prvkov==} ,' iba Cas ' {.... 65........ } ,' ' ,' Nezastavuje ' {.... 67 .......} ,' Delay spomal¡ ' ,' Etapy stop ' ,' Cyklus stop ' ,' Vn£torn˜ cyklus ' {== tempo ukazky ==} ,' Krokovanie ' ,' Esc ' {.... 73 ......} ,' ' ,' ' ,' cakaj = 0 ' {.... 76 ......} ,' cakaj = 50 ' ,' cakaj = 100 ' {== delay ==} ,' cakaj = 200 ' ,' cakaj = 500 ' {.... 80 .....} ); var a : array [-3335..10000] of integer; tx : array [0..6] of integer; tl,ty : integer; p1,p2 : integer; mx,my,y1 : integer; me : real; bola_vymena : boolean; limit,limit1 : integer; r3 : string[3]; {... p a r a m e t e r ... na konci reŸazca de¨ifruje ‡¡slo } function parameter(r:string) : integer; var i,j,kod : integer; ret : string; begin ret:=copy(r,2+pos('=',r),6); i:=pos(' ',ret)-1; val(copy(ret,1,i),j,kod); if kod>0 then parameter:=10 else parameter:=j; end; {........ n a j d e v t e x t e prv‚ velk‚ p¡smeno..} function Prve_velke(i:integer; var kde:integer):char; var j : integer; r:string; begin r:=t[i]+'@'; j:=0; repeat j:=j+1 until r[j] in ['A'..'Z','@']; if r[j]<>'@' then begin prve_velke:=r[j]; kde:=j end else begin prve_velke:=' ' ; kde:=0 end; end; {-------- funkcia v y b e r ------------------------------- parametre : izac - indexy textov z ktor˜ch vyber me ikon x,y - s£radnice Œav‚ho horn‚ho rohu okna hodnota funkcie = index vybran‚ho textu alebo 0 } function vyber(izac,ikon:integer; var ivyber:integer):integer; var znak : char; poc_t,i,j,povodne : integer; {.. = prv‚ velke p¡smena textov .} velke_pismena : set of char; {....... p i s - t e x t - nap¡¨e i-ty text do okienka - norma lnou alebo inverznou farbou } procedure pis_text(i:integer; normalne:boolean); var z : char; j : integer; begin {.. z=t[i,j] je prv‚ velk‚ p¡smeno v texte.} z:=prve_velke(i,j); gotoxy(x0,y0+i-izac); {.. nastav¡ kursor .} if normalne then begin lowvideo; write(' ',t[i],' '); highvideo; {.. zv˜razn¡ velk‚ p¡smeno .} gotoxy(x0+j,y0+i-izac); write(z); end else begin {.. nastav¡ inverzn‚ farby .} textbackground(white); textcolor(black); lowvideo; write(' ',t[i],' '); highvideo; {.. zv˜razn¡ velk‚ p¡smeno .} gotoxy(x0+j,y0+i-izac); write(z); {.. nastav¡ norm lne farby .} textbackground(black); textcolor(white); end; end; {.......... z m e n - zmen¡ vybran˜ text..........} procedure zmen(i:integer); begin {.. doteraz vybran˜ nap¡¨e norm lne .} pis_text(ivyber,true); ivyber:=i; pis_text(ivyber,false); {..teraz vybran˜ nap¡¨e inverzne .} end; {........... r m ‡ e k o k n a ................} procedure ramcek (x,y,x1,y1:integer); var i,j:integer; const r : string[7] = 'ÉÍ»Èͼº'; {.. r[1]..Œav˜ horn˜ znak r[2]..horizont lny r[3]..prav˜ horn˜ atƒ ... } begin gotoxy(x0-1,y0-1); write(r[1]); {.. prv˜ riadok .} for i:=x0 to x1 do write(r[2]); write(r[3]); for i:=y0 to y1 do begin {.. boky .} gotoxy(x0-1,i); write(r[7]); gotoxy(x1+1,i); write(r[7]); end; gotoxy(x0-1,y1+1); write(r[4]); {.. spodn˜ ridok .} for i:=x0 to x1 do write(r[5]); write(r[6]); end; {..... t e l o f u n k c i e v ˜ b e r .............} begin textbackground(black); textcolor(white); clrscr; writeln('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»'); writeln('º º'); writeln('º T R I E D E N I E. º'); writeln('º º'); write('º '); lowvideo; write(' demon¨tra‡n‚ prostredie ');highvideo; writeln(' º'); writeln('º º'); writeln('ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͹'); writeln('º º'); write('º '); lowvideo; write('Algoritmus ');highvideo; writeln(t[c_sortu],' º'); writeln('º º'); write('º '); lowvideo; write('Rozsah ');highvideo; writeln(t[rozsah],' º'); writeln('º º'); write('º '); lowvideo; write('Charakter d t ');highvideo; writeln(copy(t[typ_dat],6,15),' º'); writeln('º º'); write('º '); lowvideo; write('Obraz d t');highvideo; writeln(t[palicky_body],' º'); writeln('º º'); write('º '); lowvideo; write('Tempo uk ‘ky ');highvideo; writeln(copy(t[tempo],4,17),' º'); writeln('º º'); write('º '); lowvideo; write('Delay ');highvideo; writeln(t[spomalenie],' º'); writeln('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ'); povodne:=ivyber; ramcek(x0,y0,x0+length(t[izac])+1,y0+ikon-izac); {.. p¡¨e texty .} velke_pismena:=[]; for i:=izac to ikon do begin pis_text(i,true); {.. norm lne .} {.. mno‘ina velk˜ch p¡smen .} velke_pismena:=velke_pismena+[prve_velke(i,j)]; end; pis_text(ivyber,false); {.. inverzne .} {... cyklus vyberania ...} repeat znak:=upcase(readkey); {.. ak pre‡¡tan˜ znak je prv‚ velk‚ p¡smeno textu .} if znak in velke_pismena then begin i:=izac; {.. najdem i = index textu, ktor˜ to je .} while prve_velke(i,j)<>znak do i:=i+1; zmen(i); delay(300); end else if znak=#0 then {.. ak je to ¨ipka .} case readkey of dole : if ivyber<ikon then zmen(ivyber+1) else zmen(izac); hore : if ivyber>izac then zmen(ivyber-1) else zmen(ikon); end; {.. vyberanie kon‡¡ ak Ÿuknem <CR> alebo <ESC> alebo prv‚ p¡smeno textu .} until (znak in velke_pismena) or (znak=#13) or (znak=#27); {.. nastav¡ hodnotu funkcie = 0 ak som si nevybral <ESC> inak = index vybran‚ho textu .} if znak=#27 then vyber:=povodne else vyber:=ivyber; clrscr; end; {[[[[[[[[[[[[[[[[[[[[[[ end menu ]]]]]]]]]]]]]]]]]]]]]]]]]]]]} {.......... p r ¡ p r a v a - rozmery obrazovky .} procedure priprava; var i, dr, mo : integer; begin detectgraph(dr, mo); initgraph(dr, mo, cesta_bgi); mx:=getmaxx; my:=getmaxy; closegraph; textbackground(black); clrscr; tl:=(mx-3) div 7; for i:=0 to 6 do tx[i]:=tl*i+3; ty:=my-12; end; procedure napis(r:string; c:integer); var s : string[5]; begin str(c,s); r:=r+s; setfillstyle(emptyfill,white); bar(0,my-49,sirka*(length(r)+1),my-39); setfillstyle(solidfill,white); outtextxy(0,my-49,r); end; procedure zobraz_tempo(i:integer; normal:boolean); begin if normal then begin setcolor(white); outtextxy(tx[i],ty-3,te[i]) end else begin bar(tx[i]-2,ty-3,tx[i]+tl,ty+vyska); setcolor(black); outtextxy(tx[i],ty-3,te[i]); setcolor(white); end; end; procedure zmaz_tempo(i:integer); begin setfillstyle(emptyfill,white); bar(tx[i]-2,ty-3,tx[i]+tl,ty+vyska); setfillstyle(solidfill,white); end; procedure premaz_delay; var r : string[3]; begin str(cakanie:3,r); te[1]:=copy(te[1],1,7)+r; zmaz_tempo(1); zobraz_tempo(1,false); end; procedure zmena(z:char); var delta,nc : integer; begin z:=upcase(z); if z in ['E','D','C','V','K','N',#27,'+','-','='] then case z of {.. stop pre vonkaj¨¡ cyklus ..} 'C' : begin etapy_stop:=true; cakaj:=false; cyklus_stop:=true; esc:=false; cyklus_vnutri:=false; temp:=3; krok_stop:=false; end; {.. stop pre etapy ..} 'E' : begin etapy_stop:=true; cakaj:=false; cyklus_stop:=false; esc:=false; cyklus_vnutri:=false; temp:=2; krok_stop:=false; end; {.. spomaluje Delay ..} 'D' : begin etapy_stop:=false; cakaj:=true; cyklus_stop:=false; esc:=false; cyklus_vnutri:=false; temp:=1; krok_stop:=false; end; {.. stop pre Vnutorn˜ cyklus ..} 'V' : begin etapy_stop:=true; cakaj:=false; cyklus_stop:=true; esc:=false; cyklus_vnutri:=true; temp:=4; krok_stop:=false; end; {.. stop po kroku ..} 'K' : begin etapy_stop:=true; cakaj:=false; cyklus_stop:=true; esc:=false; cyklus_vnutri:=true; temp:=5; krok_stop:=true; end; {.. Nezastavuje be‘¡ ..} 'N' : begin etapy_stop:=false; cakaj:=false; cyklus_stop:=false; esc:=false; cyklus_vnutri:=false; temp:=0; krok_stop:=false; end; {.. Esc ukon‡¡ uk ‘ku ..} #27 : begin etapy_stop:=false; cakaj:=false; cyklus_stop:=false; esc:=true; cyklus_vnutri:=false; temp:=6; krok_stop:=false; end; '+','-','=' : if cakaj then begin delta:=cakanie div 10+1; if z='-' then begin nc:=cakanie-delta; if nc<0 then nc:=0; end else begin nc:=cakanie+delta; if nc>500 then nc:=500; end; if nc<>cakanie then begin cakanie:=nc; premaz_delay; end; end; end; if c_tempa<>temp then begin zmaz_tempo(c_tempa); zmaz_tempo(temp); zobraz_tempo(c_tempa,true); zobraz_tempo(temp,false); c_tempa:=temp; end; end; {......... g e n e r u j e d a t a p r e S O R T .....} procedure generuj; var vstup : text; i : integer; begin clrscr; me:=mx/n; if c_sortu=8 then me:=me/3; { treesort } limit:=my-50; if palicky_body=zac_p then case c_sortu of 4,8,9 : begin limit:=limit div 2; limit1:=limit; end; 7 : begin limit:=limit div 3; limit1:=limit+20; end; end; case typ_dat-zac_char of {.. vzostupne .} 0 : for i:=1 to n do a[i]:=10+round((limit-10)/n*i); {.. zostupne .} 1 : for i:=1 to n do a[n+1-i]:=10+round((limit-10)/n*i); {.. n hodne .} 2 : for i:=1 to n do a[i]:=1+random(limit); {.. kon¨tanty .} 3 : for i:=1 to n do a[i]:=limit div 2; 4 : begin write('meno vstupn‚ho s£boru dat : '); readln(meno_dat_suboru); if meno_dat_suboru='' then meno_dat_suboru:='sort.dat'; assign(vstup,meno_dat_suboru); reset(vstup); for i:=1 to n do read(vstup,a[i]); close(vstup); end; end; end; {............. zobraz¡ p r v o k ....................... alebo aj vyma‘e, keƒ je farba ‡ierna } procedure prvok(i:integer; farba:integer); var poz:integer; begin poz:=round(i*me); case palicky_body of palica : begin setcolor(farba); line(poz,limit,poz,limit-a[i]); end; bodka : putpixel(poz,limit-a[i],farba); end; end; procedure palicka(i,farba:integer;hore:boolean); var is : integer; begin is:=round(abs(i)*me); if palicky_body=palica then begin setcolor(farba); if hore then line(is,limit,is,limit-a[i]) else line(is,limit1,is,limit1+a[i]) end else putpixel(is,limit-a[i],farba); end; {............. v ˜ m e n a ..............................} procedure vymena(i,j:integer); var pom : integer; begin bola_vymena:=true; {.. vymazaŸ .} prvok(i,black); prvok(j,black); pom:=a[i]; a[i]:= a[j]; a[j]:=pom; if cakaj then delay(cakanie); if krok_stop or keypressed then zmena(readkey); prvok(i,white); prvok(j,white); {.. znova nakresliŸ .} if cakaj then delay(cakanie); end; {=========== I N S E R T S O R T =====================} procedure insertsort; var i,j,p : integer; begin for i:=1 to n do prvok(i,white); for i:=2 to n do if not esc then begin if cyklus_stop then zmena(readkey); if a[i-1]>a[i] then begin j:=i; p:=a[i]; a[0]:=p; prvok(i,black); if krok_stop then zmena(readkey); repeat j:=j-1; prvok(j,black); a[j+1]:=a[j]; prvok(j+1,white); if keypressed or krok_stop then zmena(readkey); if cakaj then delay(cakanie); until (a[j-1]<=p) or esc; a[j]:=p; prvok(j,white); if krok_stop then zmena(readkey); end end; end; {============== B U B B L E S O R T =================} procedure bubblesort; var i,j : integer; begin for i:=1 to n do prvok(i,white); for i:= n downto 2 do if not esc then begin if cyklus_stop then zmena(readkey); for j:= 2 to i do if not esc then begin if a[j-1]>a[j] then vymena(j,j-1); if keypressed then zmena(readkey); end; end; end; {========= S H A K E R S O R T ======================} procedure shakersort; var j,vmin,vmin_n,vmax,vmax_n : integer; begin for j:=1 to n do prvok(j,white); vmax:=n; vmin:=1; repeat if not esc then begin j:=vmin; repeat j:=j+1; if a[j-1]>a[j] then begin vymena(j,j-1); vmax_n:=j-1; end; until j>=vmax; vmax:=vmax_n; if cyklus_stop then zmena(readkey); end; if not esc then begin j:=vmax+1; repeat j:=j-1; if a[j-1]>a[j] then begin vymena(j,j-1); vmin_n:=j; end; until j-1<=vmin; vmin:=vmin_n; end; if etapy_stop or cyklus_stop then zmena(readkey); until (vmin>=vmax) or esc; end; {========== S H E L L S O R T =========================} procedure shellsort; var k,i : integer; procedure insert(z,k:integer; hore:boolean); var i,j,p : integer; begin i:=z; repeat i:=i+k; if a[i-k]>a[i] then if not esc then begin if cyklus_vnutri then zmena(readkey); j:=i; p:=a[i]; a[z-k]:=p; palicka(i,black,hore); if cakaj then delay(cakanie); if krok_stop then zmena(readkey); repeat j:=j-k; palicka(j,black,hore); a[j+k]:=a[j]; palicka(j+k,white,hore); if cakaj then delay(cakanie); if krok_stop or keypressed then zmena(readkey); until a[j-k]<=p; if cakaj then delay(cakanie); if krok_stop then zmena(readkey); a[j]:=p; palicka(j,white,hore); end; until (i>n-k) or esc; end; procedure otoc(i,k:integer; hore:boolean); var j : integer; begin j:=i; repeat palicka(j,black,hore); palicka(j,white,not hore); j:=j+k; until j>n; end; {................... telo S H E L L ......................} begin for i:=1 to n do palicka(i,white,true); k:=1; repeat k:=3*k+1 until k>n div 6; repeat napis('krok : ',k); for i:=1 to k do if not esc then begin if cyklus_stop then zmena(readkey); otoc(i,k,true); insert(i,k,false); otoc(i,k,false); end; k:=k div 3; if etapy_stop or cyklus_stop then zmena(readkey); until (k=1) or esc; if not esc then begin napis('normalny insertsort krok : ',k); insert(1,1,true); end end; {===== Q U I C K S O R T =======================} procedure quicksort(zac,kon:integer); var i,j,pivot : integer; begin pivot:=(a[zac]+a[kon]) div 2; i:=zac-1; j:=kon+1; repeat repeat i:=i+1 until a[i]>=pivot; repeat j:=j-1 until a[j]<=pivot; if cyklus_vnutri then zmena(readkey); if i<j then vymena(i,j); until (i>=j) or esc; if etapy_stop and (kon-zac>20) then zmena(readkey); if i=j then begin i:=i+1; j:=j-1; end; if (j>zac) and not esc then quicksort(zac,j); if (i<kon) and not esc then quicksort(i,kon); end; {========= D O B O S I E W I C Z ======================} procedure dobosiewiczsort; var j,k : integer; begin for j:=1 to n do prvok(j,white); k:=n; repeat if k>1 then k:=k * 3 div 4; napis('krok : ',k); for j:= k+1 to n do if not esc then if a[j-k]>a[j] then vymena(j,j-k); if cyklus_stop then zmena(readkey); if k>1 then k:=k * 3 div 4; napis('krok : ',k); bola_vymena:=false; for j:= n downto k+1 do if not esc then if a[j-k]>a[j] then vymena(j,j-k); if etapy_stop or cyklus_stop then zmena(readkey); until (k=1) and not bola_vymena or esc; end; {============ M E R G E S O R T - rekurz¡vny ==============} procedure mergesort; {--------------------------------------------------------------------------- uloha : dane pole a[] striedit metodou zlucovania ---------------------------------------------------------------------------} const hore = true; dole = false; show : boolean = true; znak : char = ' '; var { p : array[1..100] of integer;} u,i : integer; {----------------------vlastne triedenie zlucovanim ----------------------} procedure merge(z,k:integer); { striedi dany usek a[z].....a[k] metodou rekurzivneho zlucovania : 1. rozdeli usek na dve casti 2. rozdelene casti zvlast striedi ( rekurzivne ) 3. zlucenie (merge) utriedenych casti } var stred : integer; {----------------------zlucovanie dvoch casti------------------------------} procedure zluc(z1,k1,z2,k2:integer); { zlucuje dve casti : z1..k1 z2..k2 pomocou pomocneho pola p } var i,j,k : integer; {----------------------------------prenes----------------------------------} procedure prenes(var co:integer); { prenesie mensi prvok do pola p } begin a[-k]:=a[co]; palicka(co,black,hore); palicka(-k,white,dole); if keypressed or krok_stop then zmena(readkey); if cakaj then delay(cakanie); co:=co+1; { zmeny indexov co.. vystupny parameter } k:=k+1; { k... globalny v procedure zluc } end; {----------------------------------kopiruj---------------------------------} procedure kopiruj(od,po:integer); { kopiruje zvysok do pola p } var i : integer; begin for i:=od to po do begin a[-k]:=a[i]; palicka(i,black,hore); palicka(-k,white,dole); if cakaj then delay(cakanie); if keypressed or krok_stop then zmena(readkey); k:=k+1; end; end; {--------------------------zlucovanie------------------------------------} begin i:=z1; { i.. index najmensieho prvku v prvej casti } j:=z2; { j.. index najmensieho prvku v druhej casti } k:=z1; { k.. index v vysledku } {.... cyklus zlucovania ....} repeat if a[i]<a[j] then prenes(i) { mensi prvok prenesieme do vysledneho } else prenes(j); until (i>k1) or (j>k2) or esc; { cyklus konci ak jedna z casti konci } if (i>k1) and not esc then kopiruj(j,k2) { zvysok zkopirujeme do vysledku } else kopiruj(i,k1); {... zastavuje qoli vykladu ...} if etapy_stop and (k2-z1>20) or cyklus_stop then zmena(readkey); { vysledok z pomocneho pola p penesieme do a[] } if not esc then for i:=z1 to k2 do begin if keypressed then zmena(readkey); a[i]:=a[-i]; palicka(-i,black,dole); palicka(i,white,hore); end; end; {----------------------------merge----------------------------------------} begin u:=u+1; { u.. uroven rekurzie} if (z<k) and not esc then {.. ak ma pole aspon dva prvky => rozdelime } begin setcolor(white); { vodorovnou useckou znazornime uroven rekurzie } line(round(z*me),limit+5+u,round(k*me),limit+5+u); stred:=(z+k) div 2; {.. stred pola } if not esc then merge(z,stred); {.. striedenie 1.casti } if not esc then merge(stred+1,k); {.. striedenie 2.casti } if not esc then zluc(z,stred,stred+1,k); {.. zlucenie dvoch casti } setcolor(black); line(round(z*me),limit+5+u,round(k*me),limit+5+u); { vymazeme usecku } end; u:=u-1; end; {--------------- telo m e r g r e s o r t rekurz¡vne-------} begin u:=0; znak:=' '; for i:=1 to n do palicka(i,white,hore); merge(1,n); end; {================ T R E E S O R T ========================} procedure treesort; var i,p,zarazka : integer; procedure obsad(i:integer); var s1 : integer; begin s1:=2*i; if s1<2*n then if a[s1]>a[s1+1] then s1:=s1+1; a[i]:=a[s1]; if a[i]<zarazka then palicka(i,white,false); if cakaj then delay(cakanie); if keypressed or krok_stop then zmena(readkey); palicka(s1,black,false); if (s1<n) and (a[i]<zarazka) then obsad(s1) else begin a[s1]:=zarazka; end; end; begin zarazka:=limit+1; for i:=2*n-1 downto n do begin a[i]:=a[i+1-n]; palicka(i,white,true); if keypressed then zmena(readkey); end; for i:=n to 2*n-1 do if not esc then begin palicka(i,black,true); if keypressed then zmena(readkey); palicka(i,white,false); end; for i:=n-1 downto 1 do if not esc then obsad(i); if etapy_stop then zmena(readkey); for i:=2*n to 3*n-1 do if not esc then begin a[i]:=a[1]; palicka(1,black,false); palicka(i,white,true); obsad(1); end; end; {================== H E A P S O R T ==================} procedure heapsort; var i,p : integer; procedure vymena(i,j:integer;penzia:boolean); var p : integer; begin palicka(i,black,false); palicka(j,black,false); p:=a[i]; a[i]:=a[j]; a[j]:=p; if cakaj then delay(cakanie); if keypressed or krok_stop then zmena(readkey); palicka(i,white,false); if penzia then palicka(j,white,true) else palicka(j,white,false); end; procedure halda(i,dlzka:integer); var o,s1 : integer; begin o:=i; s1:=2*o; if s1<=dlzka then begin if s1<dlzka then if a[s1]<a[s1+1] then s1:=s1+1; if cakaj then delay(cakanie); if keypressed or krok_stop then zmena(readkey); if a[o]<a[s1] then begin vymena(o,s1,false); halda(s1,dlzka); end; end; end; begin for i:=1 to n do palicka(i,white,true); for i:=n downto n div 2+1 do if not esc then begin if cakaj then delay(cakanie); palicka(i,black,true); if keypressed then zmena(readkey); palicka(i,white,false); end; if etapy_stop then zmena(readkey); if not esc then for i:=n div 2 downto 1 do if not esc then begin palicka(i,black,true); palicka(i,white,false); if keypressed then zmena(readkey); halda(i,n); end; if etapy_stop then zmena(readkey); for i:=n downto 2 do if not esc then begin vymena(1,i,true); if keypressed then zmena(readkey); halda(1,i-1); end; palicka(1,black,false); palicka(1,white,true); end; {============== M A X S O R T =================} procedure maxsort; var i,j,max : integer; begin for i:=1 to n do prvok(i,white); for i:= n downto 2 do if not esc then begin if cyklus_stop then zmena(readkey); max:=1; for j:= 2 to i do if not esc then begin if a[j]>a[max] then max:=j; if cakaj then delay(cakanie); if keypressed then zmena(readkey); end; if not esc then vymena(max,i); end; end; {====== v y v o l v a n i e S O R T O V ======} {====== ======} procedure sortuj; var i : integer; s,s1,sh,sm,ss : string; hod,min,sek,s100 : word; stare_tempo : char; begin generuj; {... zobrazenie ..} detectgraph(p1,p2); initgraph(p1,p2,cesta_bgi); s:=t[c_sortu]; sh:=''; for i:=1 to length(s) do sh:=sh+upcase(s[i])+' '; str(n,s1); settextstyle(triplexfont,horizdir,1); outtextxy(0,my-40,'n : '+s1+' '+sh); settextstyle(smallfont,horizdir,5); c_tempa:=tempo-zac_t; for i:=0 to 6 do zobraz_tempo(i,i<>c_tempa); zmena(t[tempo,4]); settextstyle(smallfont,horizdir,05); settime(0,0,0,0); {.. t r i e d e n i e .} case c_sortu of 1 : insertsort; 2 : Bubblesort; 3 : Shakersort; 4 : shellsort; 5 : begin for i:=1 to n do prvok(i,white); Quicksort(1,n); end; 6 : dobosiewiczsort; 7 : mergesort; 8 : treesort; 9 : heapsort; 10 : maxsort; end; {.. prij¡mame gratul cie .} gettime(hod,min,sek,s100); for i:=0 to 6 do zmaz_tempo(i); setcolor(white); str(hod,sh); str(min,sm); str(sek+s100/100:1:2,ss); outtextxy(0,my-15,'cas : '+sh+':'+sm+':'+ss+' press <Esc> '); repeat until readkey=#27; closegraph; end; {========== ==========} {========== h l a v n ˜ p r o g r a m ==========} {========== ==========} begin priprava; repeat { ==== h l a v n ‚ m e n u ==== } cislo_submenu:=vyber(zac_main,kon_main,cislo_submenu); case cislo_submenu-zac_main+1 of {.. tempo uk ‘ky ..} 1 : begin tempo:=vyber(zac_t,kon_t,tempo); if tempo=tempo_spomal then begin spomalenie:=vyber(zac_d,kon_d,spomalenie); cakanie:=parameter(t[spomalenie]); str(cakanie:3,r3); te[1]:=copy(te[1],1,7)+r3; end; end; {.. nastavujem algoritmus .} 2 : c_sortu:=vyber(zac_a,kon_a,c_sortu); 3 : begin {.. nastavujem rozsah dat .} rozsah:=vyber(zac_r,kon_r,rozsah); n:=parameter(t[rozsah]); end; {.. charakter vstupu .} 4 : typ_dat:=vyber(zac_char,kon_char,typ_dat); {.. sp“sob vykreslenia .} 5 : palicky_body:=vyber(zac_p,kon_p,palicky_body); 6 : sortuj; {.. triedenie .} 0,7 : halt; { Quit = ukon‡enie .} end; until false; end.