{programova jednotka demonstrujici algoritmy vnitrniho trideni} unit trideni; interface const Max = 100; {maximalni velikost trideneho pole} type keytype = integer; item = record key : keytype; { dalsi polozky } end; index = 0..Max; index1 = 1..Max; pole = array [index] of item; tab = record A : pole; { v poli A[1] ... A[D] tridene pole } D : index1; { velikost pole } end; {tridici algoritmy: } procedure prime_zatridovani(var T:tab); procedure binarni_zatridovani(var T:tab); procedure primy_vyber(var T:tab); procedure shake_sort(var T:tab); procedure heap_sort(var T:tab); procedure mergesort(var T:tab); {pomocne procedury} procedure precti(var F:text; var T:tab); procedure vypis(var F:text; T:tab); implementation procedure prime_zatridovani(var T:tab); var I,J :index; begin with T do begin for I:=2 to D do { predpokladam, ze pole A[1]..A[I-1] je jiz setrideno } { zaradim na spravne misto prvek A[I] } begin A[0]:=A[I]; J:=I-1; { A[0] je zarazka } while A[0].key < A[j].key do begin A[J+1]:=A[J]; J:=J-1; end; A[J+1]:=A[0]; end; end; end; procedure binarni_zatridovani(var T:tab); var X : Item; I,J, L,R,M :index; {levy, pravy okraj a stred podezreleho intervalu} begin with T do begin { predpokladam, ze pole A[1]..A[I-1] je jiz setrideno } { zaradim na spravne misto prvek A[I] } for I:=2 to D do begin X:=A[I]; { zarazuji X } L:=1; R:=I-1; { do intervalu 1..I-1 } while L<=R do begin {podezrely interval je neprazdny} M:=(L+R) div 2; if X.key < A[M].key then R:=M-1 else L:=M+1; end; for J:=I-1 downto L do A[J+1]:=A[J]; A[L]:=X; end; end; end; procedure primy_vyber(var T:tab); var I,J, Imin : index; {index minima z A[I]..A[D]} X : item; {hodnota minima z A[I]..A[D] } begin with T do begin for I:=1 to D-1 do begin X:=A[I]; Imin:=I; for J:=I+1 to D do if A[J].key A[J].key then begin X:=A[J-1]; A[J-1]:=A[J]; A[J]:=X; K:=J; end; L:=K+1; {pod posledni vymenou je setrideno} {velke bublaji nahoru:} for J:=L to R do if A[J-1].Key > A[J].key then begin X:=A[J-1]; A[J-1]:=A[J]; A[J]:=X; K:=J; end; R:=K-1; {nad posledni vymenou je setrideno} until L>R; {je setrideno vse} end; end; procedure heap_sort(var T:tab); var X: item; L,R : index; procedure sift; { mohla by mit parametry - (L,R:index); volala se vsak vzdy sift(L,R) je tedy efektivnejsi takto } { predpoklada, ze pole A[L+1]...A[R] je hromadou (s maximem v koreni), prida k ni prvek A[L] } var I,J:integer; begin {of sift} with T do begin I:=L; J:=2*I; X:=A[I]; while J<=R do begin if J=A[J].key then {uz je to OK} break; A[I]:=A[J]; {zarazeni} I:=J; J:=2*I; {dale do stromu} end; A[I]:=X; end; end; {of sift} begin with T do begin L:=(D div 2)+1; R:=D; { postaveni hromady s maximem v koreni } while L>1 do begin L:=L-1; sift { (L,R); } end; { postupne proseti vsech prvku hromadou: } while R>1 do begin { v A[1] je maximum, prijde na konec na index R, prvek, ktery tam byl na zacatek } X:=A[1]; A[1]:=A[R]; A[R]:=X; R:=R-1; { vytvorim hromadu z A[1]..A[R] } sift { (L,R); } end; end { of with } end {of heapsort }; procedure mergesort(var T:tab); var B:pole; procedure msort(L,R:index1); var I,J,K, M :index1; begin {of nsort} if R>L then with T do begin M:=(R+L) div 2; msort(1,M); msort(M+1,R); for I:=M downto L do B[I]:=A[I]; for J:=M+1 to R do B[R+M+1-J]:=A[J]; I:=L; J:=R; for K:=L to R do if B[I].key=L do begin {cisel na plnou radku} for K:=I to I+L do write(F,A[K].key:FI); writeln(F); PD:=PD-L; { L cisel vystoupilo } I:=I+L; end; if I<=D then begin {jeste maji vystoupit cisla A[I]...A[D]} for K:=I to D do write(F,A[K].key:FI); writeln(F); end; end {of with } end; end.