Форум программистов [Powered by Invision Power Board]

Код

program Project2;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils;

type
  matr = array [1 .. 10, 1 .. 10] of integer;
  mas = array [1 .. 100] of integer;

var
  i, j, n, m, z: integer;
  mat: matr;
  s: mas;

function sum(a: matr; r, c: integer; var p: integer): mas;
var
  k: integer; sm: mas;
begin
  p := 1;
  for i := 1 to r do
  begin
    for j := 1 to c do
    begin
      if a[i, j] < 0 then
      begin
        sm[p] := 0;
        for k := 1 to c do
        begin
          sm[p] := sm[p] + a[i, k];
        end;
        p := p + 1;
         break;
      end;
    end;
  end;
  sum := sm;
end;

procedure nomera(a: matr; r, c: integer);
var
  minrow, maxrow: integer;
  // номера минимального и максимального элементов в строке
  mincol, maxcol: integer; //
begin
  writeln('координаты седловых точек:');
  for i := 1 to r do
  begin
    // находим минимальный и максимальный элементы в строке
    minrow := 1;
    maxrow := 1;
    for j := 1 to c do
    begin
      if a[i, minrow] > a[i, j] then
        minrow := j;
      if a[i, maxrow] < a[i, j] then
        maxrow := j;
    end;
    // проверяем столбцы минимального и максимального элемента в строке
    // мы можем сделать это в одном цикле, т.к в столбце мин. элем. нам нужен
    // только макс. элем., а в столбце макс. элем. только мин.элем
    mincol := 1;
    maxcol := 1;
    for j := 1 to c do
    begin
      if a[mincol, maxrow] > a[j, maxrow] then
        mincol := j;
      if a[maxcol, minrow] < a[j, minrow] then
        maxcol := j;
    end;
    // ответ
    if mincol = i then
      writeln('№ строки: ', i, ' № столбца: ', maxrow);
    if maxcol = i then
      writeln('№ строки: ', i, ' № столбца: ', minrow);
  end;
end;

begin
  writeln('введите размеры матрицы');
  readln(n, m);
  for i := 1 to n do
  begin
    for j := 1 to m do
    begin
      writeln('введите ', i, '-й ', j, '-й элемент матрицы');
      readln(mat[i, j]);
    end;
  end;
  writeln;
  for i := 1 to n do
  begin
    for j := 1 to m do
    begin
      write(mat[i, j], ' ');
    end;
    writeln;
  end;
  s := sum(mat, n, m, z);
  if z > 1 then
  begin
    writeln;
    for i := 1 to z - 1 do
    begin
      writeln(s[i]);
    end;
  end;
  writeln;
  nomera(mat, n, m);
  readln;
end.