Страница 1 из 1
Pascal. Двумерные массивы.
Добавлено: 22 май 2008, 21:56
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;
А по второй задаче пока мыслей никаких нет :-(
Re: Pascal. Двумерные массивы.
Добавлено: 23 май 2008, 11:26
Хыиуду
По первой задаче - алгоритм нахождения максимума/минимума в массиве находится в разделе "Алгоритмы". Проходимся по всем строкам, находим в каждой минимум, потом в том же столбце ищем максимум. Если номер максимального элемента совпал с номером строки - точка седловая, обнуляем.
По второй - вот функция, определяющая совершенное число.
Код: Выделить всё
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;
Re: Pascal. Двумерные массивы.
Добавлено: 24 май 2008, 11:31
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.
Я не совсем поняла, что означают переменные в этой функции и запуталась.
Re: Pascal. Двумерные массивы.
Добавлено: 24 май 2008, 16:44
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.
Минимальные элементы в строках и максимальные в столбцах я нашла, но как вычислить седловую точку - не понимаю. Но чувствую, что уже вот вот и тут оно.
И ещё вопрос: седловой точки может и не быть вовсе в матрице? Помогите пожалуйста, послезавтра надо сдать уже!
Re: Pascal. Двумерные массивы.
Добавлено: 24 май 2008, 22:59
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.
Но что-то всё-таки не так, поправьте пожалуйста. Немного не так обнуляются столбцы и строки. Помогите плииииииииииииииииииз :-((((
Re: Pascal. Двумерные массивы.
Добавлено: 25 май 2008, 01:44
KMarina
Помогите пожалуйста кто-нибудь! Буду благодарна очень!!!
Re: Pascal. Двумерные массивы.
Добавлено: 25 май 2008, 02:43
KMarina
Вторую задачку всё-таки решила! Помогите с первой! Она ведь лёгкая, просто я плохо разбираюсь =(
Re: Pascal. Двумерные массивы.
Добавлено: 25 май 2008, 07:16
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]
Re: Pascal. Двумерные массивы.
Добавлено: 25 май 2008, 12:00
KMarina
2Sender Ghost: большое спасибо! Ты мне очень помог!