Задание по лабораторной

program prog;
 
{$R+}
{$I-}
 
const
  N = 4;
  M = 5;
 
type
  TMatrix = array[1..N, 1..M] of Integer;
  TVector = array[1..N] of Integer;
  TCompare = function(a, b: Integer): Boolean;
 
function ReadMatrix(var matrix: TMatrix): Boolean;
var
  i, j: Integer;
begin
  for i:= 1 to N do begin
    for j:= 1 to M do begin
      Read(matrix[i,j]);
      if IOResult <> 0 then begin
        ReadMatrix:= false;
        Exit;
      end;
    end;      
  end;
  ReadMatrix:= true;
end;
  
procedure WriteMatrix(const matrix: TMatrix; const width: Integer);
var
  i, j: Integer;
begin
  for i:= 1 to N do begin
    for j:= 1 to M do
      Write(matrix[i,j]:width);
    WriteLn;
  end;
end;
 
procedure WriteVector(const vector: TVector; const width: Integer);
var
  i: Integer;
begin
  for i:= 1 to N do
    Write(vector[i]:width);
  WriteLn;
end;
 
procedure FillVector(var vector: TVector; const matrix: TMatrix);
var
  i, j, k: Integer;
begin
    for i:= 1 to N do begin
      k:= 1;
      for j:= 2 to M do begin
        if matrix[i,j] < matrix[i,k] then
          k:= j;
      end;
      vector[i]:= k;
    end;
end;
 
function OddPosition(const vector: TVector): Integer;
var
  i: Integer;
begin
  for i:= 1 to N do begin
    if Odd(vector[i]) then begin
      OddPosition:= i;
      Exit;
    end;
  end;
  OddPosition:= 0;
end;
 
(* вставками *)
procedure SortRowsByCol(var matrix: TMatrix; col: Integer; comp: TCompare);
var
  i, j, k: Integer;
  x: array[1..M] of Integer;
begin  
  for i:= 2 to N do begin
    for k:= 1 to M do
      x[k]:= matrix[i,k];
 
    j:= i-1;
    while (j > 0) and not comp(matrix[j,col], x[col]) do begin
      for k:= 1 to M do
        matrix[j+1,k]:= matrix[j,k];
      Dec(j);
    end;
 
    if j + 1 <> i then
      for k:= 1 to M do
        matrix[j+1,k]:= x[k];
  end;
end;
 
function Compare(a, b: Integer): Boolean;
begin
  Compare:= (a > b);
end;
 
procedure HaltWithMsg(const msg: String);
begin
  WriteLn(msg);
  Halt;
end;
 
const
  WIDTH = 4;
var
  oddPos: Integer;
  col: Integer;
  matrix: TMatrix;
  vector: TVector;
begin
  WriteLn('сортировать по столбцу с номером(1..', M, ')');
  ReadLn(col);
  if (IOResult <> 0) or (col < 1) or (col > M) then
    HaltWithMsg('ошибка ввода');
 
  WriteLn('матрица(', N, 'x', M, '):');
  if not ReadMatrix(matrix) then
    HaltWithMsg('ошибка ввода');
    
  WriteLn('исходная матрица');
  WriteMatrix(matrix, WIDTH);
 
  FillVector(vector, matrix);
  Write('вектор(позиция первого нечётного элемента: ');
  oddPos:= OddPosition(vector);
  if oddPos <> 0 then
    WriteLn(oddPos, ')')
  else
    WriteLn('не найдена)');  
  WriteVector(vector, WIDTH);
  
  SortRowsByCol(matrix, col, Compare);
  WriteLn('матрица отсортированная в порядке убывания элементов ', col, ' столбца');
  WriteMatrix(matrix, WIDTH); 
end.