Pascal. Двумерные массивы.

[KMarina]

Помогите пожалуйста решить парочку задачек на двумерные массивы.

1. Дана целочисленная матрица A(m,n). Обнулить строки и столбцы матрицы, на пересечении которых стоит седловая точка. Седловой точкой называется точка, в которой находится максимальный в столбце и одновременно минимальный в строке элемент.

2. Составить программу, которая находит в двумерном массиве произвольной размерности все совершенные числа, не превышающие заранее заданного числа. Натуральное число называется совершенным, если оно равно сумме всех своих натуральных делителей, за исключением самого себя. Например, число 6 является совершенным, т.к. 1+2+3=6, а 8 не является совершенным (1+2+4 не равно 8).


По первой задаче получается всё, до того момента, когда нужно искать эту самую седловую точку. Помогите плиз.

Код: Выделить всё

program prog_1;

uses crt;

var A,B:array[1..50,1..50] of Integer;

Max_stolbec,Min_stroka,m,n,i,j:integer;

begin

clrscr;

write('Vvedite m: ');

readln(m);

write('Vvedite n: ');

readln(n);

write('Matrica A imeet razmernost: ',m,'x',n);

writeln;

for i:=1 to m do

for j:=1 to n do begin

write('A[',i,':',j,']:');

readln(a[i,j]);

end;

for i:=1 to m do begin

for j:=1 to n do

write(A[i,j]:5);

writeln;

end;

А по второй задаче пока мыслей никаких нет :-(

[Хыиуду]

По первой задаче - алгоритм нахождения максимума/минимума в массиве находится в разделе "Алгоритмы". Проходимся по всем строкам, находим в каждой минимум, потом в том же столбце ищем максимум. Если номер максимального элемента совпал с номером строки - точка седловая, обнуляем.

По второй - вот функция, определяющая совершенное число.

Код: Выделить всё

function is_perfect(N: integer):boolean;
var i, s: integer;
begin
  s:=0;
  for i:=1 to N div 2 do
     if N mod i=0 then s:=s+i;
  is_perfect:=s=N;
end;

[KMarina]

По второй - вот функция, определяющая совершенное число.

Код: Выделить всё

function is_perfect(N: integer):boolean;
var i, s: integer;
begin
  s:=0;
  for i:=1 to N div 2 do
     if N mod i=0 then s:=s+i;
  is_perfect:=s=N;
end;

Спасибо!
Помогите теперь внедрить эту функцию в задачу.

Код: Выделить всё

program prog__1;

uses crt;

var A:array[1..100,1..100] of Integer;

is_perfect,d,s,y,i,j,n:integer;

begin

clrscr;

write('Vvedite razmernost: ');

readln(n);

write('Zadaite chislo: ');

readln(y);

for i:=1 to n do

for j:=1 to n do begin

write('A[',i,':',j,']: ');

readln(A[i,j]);

end;

for i:=1 to n do begin

for j:=1 to n do

write(A[i,j]:5);

writeln;

end;

s:=0;



writeln;



readln;

end.

Я не совсем поняла, что означают переменные в этой функции и запуталась.

[KMarina]

По первой задаче - алгоритм нахождения максимума/минимума в массиве находится в разделе "Алгоритмы". Проходимся по всем строкам, находим в каждой минимум, потом в том же столбце ищем максимум. Если номер максимального элемента совпал с номером строки - точка седловая, обнуляем.

Вот, погляди:

Код: Выделить всё

program prog;

uses crt;

var a,b:array[1..100,1..100] of Integer;

z,max_stolbca,min,min_stroka,m,n,i,j:integer;

begin

clrscr;

write('Vvedite m: ');

readln(m);

write('Vvedite n: ');

readln(n);

writeln;

for i:=1 to m do

for j:=1 to n do begin

write('Vvedite element A[',i,':',j,']:');

readln(A[i,j]);

end;

write('Massiv A:');

writeln;

for i:=1 to m do begin

for j:=1 to n do

write(A[i,j]:5);

writeln;

end;

i:=1;

repeat

min_stroka:=A[i,j];

for j:=1 to n do

if a[i,j]<min_stroka then min_stroka:=a[i,j];

i:=i+1;

writeln('Min_element_v_stroke #',i-1,': ',min_stroka);

until i>m;

j:=1;

repeat

max_stolbca:=A[i,j];

for i:=1 to m do

if a[i,j]>max_stolbca then max_stolbca:=a[i,j];

j:=j+1;

writeln('Max_element_v_stolbce #',j-1,': ',max_stolbca);

until j>n;

writeln;

for i:=1 to m do begin

for j:=1 to n do

write(A[i,j]:5);

writeln;

end;

readln;

end.

Минимальные элементы в строках и максимальные в столбцах я нашла, но как вычислить седловую точку - не понимаю. Но чувствую, что уже вот вот и тут оно.
И ещё вопрос: седловой точки может и не быть вовсе в матрице? Помогите пожалуйста, послезавтра надо сдать уже!

[KMarina]

Вот я нашла реализацию задачи с седловой точкой и заточила под свою задачу

Код: Выделить всё

Program SDP;

uses crt;

var a:array [1..50,1..50] of integer;

   n,m,i,j,k:integer;

    min_j,max_j:integer;

    b:boolean; {признак седловой точки}

begin

clrscr;

write('n: ');

readln(n);

write('m: ');

readln(m);

for i:=1 to n do

for j:=1 to m do begin

writeln('A[',i,':',j,']:');

readln(a[i,j]);

end;



for i:=1 to n do begin

for j:=1 to m do

write(a[i,j]:5);

writeln;

end;

     Writeln('Sedlovaya tochka: ');

for i:=1 to n do {проход по всем строкам}

	begin

	    min_j:=1; {индекс для min-элемента в строке}

	    max_j:=1; {индекс для max-элемента в строке}

for j:=2 to m do {проход по всем столбцам i-строки}

	begin

	    if a[i,min_j]>a[i,j] then min_j:=j;

	    if a[i,max_j]<a[i,j] then max_j:=j;

	end;

	    b:=true;

for k:=1 to n do

	if a[i,max_j]>a[k,max_j] then

{не седловая точка - выходим из цикла}

	begin

	    b:=false;

	    break; {выйти из цикла}

	end;

	if b then write('a[',i,',',max_j,'], ');

	b:=true;

for k:=1 to n do

	if a[i,min_j]<a[k,min_j] then

{не седловая точка - выходим из цикла}

	begin

	b:=false;

	break;

	end;

if b then write('a(',i,',',min_j,')');

end;

writeln;

for i:=1 to n do

for j:=1 to n do begin

a[i,min_j]:=0;

end;

for i:=1 to n do begin

for j:=1 to n do

write(a[i,j]:5);

writeln;

end;

	Readln;

end.

Но что-то всё-таки не так, поправьте пожалуйста. Немного не так обнуляются столбцы и строки. Помогите плииииииииииииииииииз :-((((

[KMarina]

Помогите пожалуйста кто-нибудь! Буду благодарна очень!!!

[KMarina]

Вторую задачку всё-таки решила! Помогите с первой! Она ведь лёгкая, просто я плохо разбираюсь =(

[Sender Ghost]

Для первой задачи.
[syntax='Pascal']
program SaddlePoint;

uses
crt;

const
Dim = 50;

var
a: Array [1..Dim, 1..Dim] of Integer;
i, j, k, m, n, min_i, max_j: Integer;
b: boolean; {признак седловой точки}

begin
clrscr;
{Ввод данных матрицы}
WriteLn('Matrix A[m x n]:');
Write('m: '); Readln(m);
Write('n: '); Readln(n);
{Проверка на максимальную размерность матрицы}
if (m > Dim) or (n > Dim) or (m < 2) or (n < 2) then
begin
WriteLn('m and n must be less than ', Dim, ' and greater than 1');
{m и n должны быть меньше чем #Dim# и больше чем 1}
Exit;
end;

for i := 1 to m do
for j := 1 to n do
begin
Write('A[', i, ',', j, ']: ');
Readln(a[i, j]);
end;
{Вывод матрицы на экран}
Writeln('Original matrix:'); {Оригинальная матрица}
for i := 1 to m do
begin
for j := 1 to n do
Write(a[i, j]:5);
Writeln;
end;

b := False;
for i := 1 to m do
begin
min_i := 1; {индекс столбца для min-элемента в строке}
for k := 2 to n do if a[i, k] < a[i, min_i] then min_i := k;
max_j := 1; {индекс строки для max-элемента в столбце}
for k := 2 to m do if a[k, min_i] > a[max_j, min_i] then max_j := k;
if i = max_j then
begin
b := True;
WriteLn('Saddle point: A[', max_j, ',', min_i, '] = ', a[max_j, min_i]);
{Обнуление строк и столбцов матрицы на пересечении седловой точки}
for k := 1 to n do a[max_j, k] := 0;
for k := 1 to m do a[k, min_i] := 0;
Break;
end;
end;

if b then
begin
Writeln('Result matrix:'); {Результирующая матрица}
for i := 1 to m do
begin
for j := 1 to n do
Write(a[i, j]:5);
Writeln;
end;
end
else WriteLn('Saddle point: not found'); {Седловая точка не найдена}

Readln;
end.
[/syntax]

[KMarina]

2Sender Ghost: большое спасибо! Ты мне очень помог!