Kód: Vybrať všetko
program triedenie;
uses crt,dos;
const n=5000;
type pole = array[1..N] of integer;
var A,B : pole;
h,m,s,ss,h1,m1,s1,ss1: word;
time: longint;
cas1,cas2: real;
procedure zacni;
var h, m, s : word;
begin
GetTime(h,m,s,ss);
Time := h * 3600 + m * 60 + s;
end;
function koniec: real;
var h, m, s, ss1 : word;
begin
GetTime(h, m, s, ss1);
koniec := h * 3600 + m * 60 + s - Time + (integer(ss1) -integer(ss)) / 1000;
end;
procedure vytvor_pole; {Vytvori nahodny vektor N cisiel}
var i : integer;
begin
Randomize;
for i := 1 to N do A[i] := Random(4000);
for i := 1 to N do B[i] := A[i];
end;
procedure max_sort;
var i,j,m,x:integer;
begin
for i:=n downto 2 do
begin
m:=1;
for j:=2 to i do
if a[j]>a[m] then m:=j;
if i<>m then
begin
x:=a[m]; a[m]:=a[i]; a[i]:=x;
end
end;
end;
procedure Merge;
var i, j, k,p,q,r: integer;
var B: pole;
begin { Merge }
i := p;
j := q + 1;
k := p;
while ((i <= q) and (j <= r)) do
begin
if (A[i] < A[j])
then begin
B[k] := A[i];
i := i + 1;
end
else begin
B[k] := A[j];
j := j + 1;
end;
k := k + 1;
end;
while (i <= q) do
begin
B[k] := A[i];
k := k + 1;
i := i + 1;
end;
while (j <= r) do
begin
B[k] := A[j];
k := k + 1;
j := j + 1;
end;
for k := p to r do A[k] := B[k];
end;
begin
clrscr;
vytvor_pole;
zacni;
max_sort;
cas1:=koniec;
writeln ('cas max sortu je',cas1:6:3,' sekund');
zacni;
merge;
cas2:=koniec;
writeln ('cas merge sortu je' , cas2:6:3,' sekund');
readln;
end.