Показать сообщение отдельно
Старый 15.12.2013, 10:02   #4 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от 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.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070