Цитата:
Сообщение от Cassan
уже не нужно)
|
И тем не менее (вдруг пригодится; в частности, фильтр ввода размера массива у Вас сделан безобразно):
Код:
Uses Crt;
Const
N = 50;
Type
T_Mas = Array [0..N+1] of Integer;
Var
Mas: T_Mas;
Kol: Integer;
Procedure Count (Var Kl:Integer);
Var
IOR:Word;
B:boolean;
Begin
{$I-}
Write('Enter the array dimension: ');
Repeat
B:=true;
ReadLn(Kl);
IOR:= IOResult;
If IOR<>0 then
begin
Writeln('Enter the integer value!');
B:=false;
end;
If B and ((Kl<2) or (Kl>N)) then
begin
Writeln('Value out of range!');
B:=false;
end;
If B and Odd(Kl) then
begin
Writeln('Dimension must be even!');
B:=false;
end;
If Not(B) then Write('Error. New value: ')
Until B;
{$I+}
End;
Procedure Filling (Kl:Integer; Var A: T_Mas);
Var
i:Integer;
Begin
Randomize;
For i:= 1 to Kl do A[i]:= Random(N)
End;
Procedure Print(Kl:Integer; A: T_Mas);
Var
i: Integer;
Begin
For i:=1 to Kl do Write(A[i]:4)
End;
Procedure Vstavkami (Kl:integer; var A: T_Mas);
var
k,i,j,buf,q:byte;
begin
A[0]:=0;
A[Kl+1]:=0;
k:= Kl div 2;
{First half Insert sorting}
for i:=2 to k do
begin
j:=i;
while A[j-1]>A[j] do
begin
buf:=A[j-1];
A[j-1]:=A[j];
A[j]:=buf;
Dec(j);
end;
end;
{Second half Insert sorting}
for i:=Kl-1 downto k+1 do
begin
j:=i;
while A[j+1]>A[j] do
begin
buf:=A[j+1];
A[j+1]:=A[j];
A[j]:=buf;
Inc(j);
end;
end;
end;
Begin
ClrScr;
Count(Kol);
Filling(Kol, Mas);
WriteLn('Initial array:');
Print (Kol, Mas);
Vstavkami (Kol, Mas);
WriteLn;
WriteLn('Sorted array:');
Print (Kol, Mas);
ReadKey
End.