Скачиваний:
32
Добавлен:
10.05.2014
Размер:
1.2 Кб
Скачать
CONST
n=10;

VAR
mass: array [1..n] of integer;
d,i,j,h,k: integer;


Procedure InitMass;
Var
i:integer;
Begin
for i:=1 to n do mass[i]:=trunc(100*sin(0.3*i+0.24));
End;


procedure Shell(var item: DataArray; count:integer);
const
t = 5;
var
i, j, k, s, m: integer;
h: array[1..t] of integer;
x: DataItem;
begin
h[1]:=9; h[2]:=5; h[3]:=3; h[4]:=2; h[5]:=1;
for m := 1 to t do
begin

k:=h[m];
s:=-k;
for i := k+1 to count do
begin
x := item[i];
j := i-k;
if s=0 then
begin
s := -k;
s := s+1;
item[s] := x;
end;
while (x<item[j]) and (j<count) do
begin
item[j+k] := item[j];
j := j-k;
end;
item[j+k] := x;
end;
end;
end; { конец сортировки Шелла }



BEGIN
InitMass;
for k:=1 to n do writeln(mass[k]);
WriteLn('***********************************************************');
Shella;
for k:=1 to n do writeln(mass[k]);
END.
Соседние файлы в папке 1