Поиск седловых точек в двумерном массиве

[Артур_1993]

Здравствуйте форумчане, поманите пожалуйста студенту с лабораторной работой!

Задание:
Для матрицы размером NxM вывести на экран все ее седловые точки. Элемент матрицы называется седловой точкой, если он является наименьшим в своей строке и одновременно наибольшим в своем столбце, или наоборот. Массивы представлять на форме в виде компонентов TStringGrid, в которых 0-й столбец и 0-ю строку использовать для отображения индексов массивов.

Заранее большое спасибо, всем кто поможет! :-)

[MooNDeaR]

Вам во фриланс. Рублей за 250 кто-нибудь может и сделает. Кто-нибудь, кто знает Delphi.

[Артур_1993]

Можно только алгоритм поиска и вывода седловых точек написать, а остальное я могу сам сделать!

ЗЫ: Так то вроде я не ошибся разделом форума! Помощь студентам...а за деньги я могу найти и так кто может сделать! :-)

[MooNDeaR]

ЗЫ: Так то вроде я не ошибся разделом форума! Помощь студентам...а за деньги я могу найти и так кто может сделать! :-)

Так-то вроде бы слово помощь подразумевает что вы уже что-то сделали и запутались, а мы вам помогаем.

Можно только алгоритм поиска и вывода седловых точек написать, а остальное я могу сам сделать!

Алгоритм:
1. Создаем матрицу A размерностью NxM и заполняем её случайными числами
2. Создаем массивы B и С размерностью N (кол-во строк)
3. Ищем в каждой i-й строке минимальный и максимальный элемент и записываем номер столбца этого минимального элемента в B[i], а максимального в C[i]
4. Проходим по массиву B[i], достаем из каждого i-го элемента номер столбца и находим в нем индекс максимального элемента в столбце. Если полученный индекс равен i, то это седловая точка.
5. Повторить для массива C то же самое, только в столбцах искать минимальный элемент.

[BDA]

program Project1;
{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

type
  tdarr = array of array of integer;

var
  a: tdarr;
  n, m: integer;

procedure fillarr(var a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
    for j := 1 to m do
      a[i, j] := random(11) - 5;
end;

procedure printarr(const a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
  begin
    for j := 1 to m do
      write(a[i, j]:4);
    writeln;
  end;
end;

procedure extraprintarr(const a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  write('   |');
  for j := 1 to m do
    write(a[0, j]:4);
  writeln('|');
  for j := 0 to m + 1 do
    write('----');
  writeln;
  for i := 1 to n do
  begin
    write(a[i, 0]:3, '|');
    for j := 1 to m do
      write(a[i, j]:4);
    write('|', a[i, m + 1]:3);
    writeln;
  end;
  for j := 0 to m + 1 do
    write('----');
  writeln;
  write('   |');
  for j := 1 to m do
    write(a[n + 1, j]:4);
  writeln('|');
end;

procedure printsaddlepoints(const a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
  begin
    for j := 1 to m do
      if (a[0, j] = a[i, m + 1]) or (a[n + 1, j] = a[i, 0]) then
      begin
        SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
          FOREGROUND_RED or FOREGROUND_INTENSITY);
        write(a[i, j]:4);
      end
      else
      begin
        SetConsoleTextAttribute(GetStdHandle(STD_OUTPUT_HANDLE),
          FOREGROUND_RED or FOREGROUND_GREEN or FOREGROUND_BLUE);
        write(a[i, j]:4);
      end;
    writeln;
  end;
end;

procedure findminmax(var a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
  begin
    a[i, 0] := a[i, 1];
    a[i, m + 1] := a[i, 1];
    for j := 2 to m do
      if a[i, j] < a[i, 0] then
        a[i, 0] := a[i, j]
      else if a[i, j] > a[i, m + 1] then
        a[i, m + 1] := a[i, j];
  end;
  for j := 1 to m do
  begin
    a[0, j] := a[1, j];
    a[n + 1, j] := a[1, j];
    for i := 2 to n do
      if a[i, j] < a[0, j] then
        a[0, j] := a[i, j]
      else if a[i, j] > a[n + 1, j] then
        a[n + 1, j] := a[i, j];
  end;
end;

begin
  randomize;
  writeln('Input matrix size (nxm):');
  readln(n, m);
  setlength(a, n + 2, m + 2);
  fillarr(a, n, m);
  writeln('Matrix:');
  printarr(a, n, m);
  findminmax(a, n, m);
  writeln;
  writeln('Matrix with min and max:');
  extraprintarr(a, n, m);
  writeln;
  writeln('Saddle points:');
  printsaddlepoints(a, n, m);
  setlength(a, 0, 0);
  readln;

end.

Текстовый вариант программы.
Должен цветом показать седловые точки, но при рандоме очень трудно получить такие точки (для проверки можно заполнить единичками всю матрицу).

Или ручной ввод:

procedure fillarr(var a: tdarr; n, m: integer);
var
  i, j: integer;
begin
  for i := 1 to n do
    for j := 1 to m do
    begin
      write('a[', i, ', ', j, '] = ');
      readln(a[i, j]);
    end;
end;