Turbo Pascal: сортировка вставками

[Cassan]

Turbo Pascal: сортировка вставками

Помогите отредактировать программу, чтобы правильно заработала.
Условие было такое:Дан одномерный массив, отсортировать первую его половину по возрастанию, а вторую по убыванию.
Здесь применялась сортировка вставками, но в самой процедуре ошибки. Помогите исправить, чтобы заработало.:tehnari_ru_837:

Uses Crt;
Const		N = 50;
Type 		T_Mas = Array [1..N] of Integer;
Var		Mas	: T_Mas;
		Kol	: Integer;

				
Procedure Count (Var Kol:Integer);
{Процедура определения размерности массива}
Var		IOR	: Word;
Begin
Write('Введите размерность массива: ');
	Repeat
		{$I-} ReadLn(Kol); {$I+}
		IOR := IOResult;
		If odd(IOR) or (Kol>N) Then
			WriteLn('Ошибка. Повторите ввод.')
	Until (Kol<=N) and (IOR=0)
End;


Procedure Filling (Kol:Integer; Var A: T_Mas);
{Процедура заполнения массива}
Var I : Integer;
Begin
	Randomize;
	For I := 1 To Kol Do A[I] := Random(N)
End;


Procedure Print (Kol:Integer; A: T_Mas);
{Процедура вывода массива}
Var I : Integer;
Begin
	For I:=1 to Kol do Write (A[I], ' ')
End;

Procedure Vstavkami (Kol:Integer; var A: T_Mas);
var k,i,j,buf:byte;
begin
k:= Kol div 2;
{сортировка вставками по возрастанию первой половины}
for i:=2 to k-1 do
  begin
    buf:=a[i];
    j:=i-1;
    while (j>=1) and (a[j]>buf) do
    begin
      a[j+1]:=a[j];
      j:=j-1;
    end;
    a[j+1]:=buf;
  end;
end;
{сортировка вставками по убыванию второй половины}
for i:=2 to Kol-1 do
  begin
    buf:=a[i];
    j:=i-1;
    while (j>=1) and (a[j]<buf) do
    begin
      a[j+1]:=a[j];
      j:=j-1;
    end;
    a[j+1]:=buf;
  end;
end;
Begin
	ClrScr;
	Count(Kol);
	Filling(Kol, Mas);
	WriteLn('Исходный массив'); Print (Kol, Mas);
	Vstavkami (Kol, Mas);
	WriteLn;
	WriteLn('Отсортированный массив'); Print (Kol, Mas);
	Repeat until KeyPressed
End.

 

[Vladimir_S]

Да... стал отлаживать, сам подзапутался, но сейчас вынужден прерваться. Завтра с утра доведу до ума.

 

[Cassan]

уже не нужно):bsod:

 

[Vladimir_S]

уже не нужно)

И тем не менее (вдруг пригодится; в частности, фильтр ввода размера массива у Вас сделан безобразно):

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.