program sort; uses Crt,Dos; const n = 10000; n2 = 20; type Item = Integer; Items = array [0..n-1] of Item; var a: Items; i: Integer; hour1,minut1,sec1,canti1, hour2,minut2,sec2,canti2: Word; fout: Text; procedure Shellsort(var a: Items); var t,i,j,k,l,s: Integer; x: Item; m: 1 .. n2; h: array [1 .. n2] of Integer; cc,mm: LongInt; begin cc:=0; mm:=0; t := Trunc(ln(n)/ln(2)-1); h[t] := 1; for k := t-1 downto 1 do begin h[k] := 2*h[k+1] + 1; end; for m := 1 to t do { Global iteration No } begin k := h[m]; { Step } for l := 0 to k-1 do { SubArray No } for i := 1 to ((N-1) div k) do begin if l+i*k < N then begin x := a[l+i*k]; j := l+(i-1)*k; while (j>=0) and (x < a[j]) do begin a[j+k] := a[j]; j := j - k; end; a[j+k] := x; end; end; end; writeln(cc,' compares ( = ', cc/exp(1.2*ln(n)):14:8, '*',N,'^1.2), '); writeln(mm,' moves ( = ', mm/exp(1.2*ln(n)):14:8, '*',N,'^1.2). '); end; Begin {ClrScr;} Assign(fout,'con'); Rewrite(fout); Randomize; for i:=0 to N-1 do { МАСИВ ВИПАДКОВИХ ЧИСЕЛ } begin a[i] := random(32000); end; if N<=100 then for i:= 0 to N-1 do begin Write(a[i],' '); end; WriteLn; GetTime(hour1,minut1,sec1,canti1); Shellsort(a); GetTime(hour2,minut2,sec2,canti2); if N<=100 then for i:= 0 to N-1 do begin Write(a[i],' '); end; WriteLn; writeln(' Початок: ',hour1:2,':',minut1:2,':',sec1:2,':',canti1:2); writeln(' Кiнець: ',hour2:2,':',minut2:2,':',sec2:2,':',canti2:2); End.