IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Задача про матрицу
mashka-promakashka
сообщение 6.03.2009 23:27
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Женский
Реальное имя: Мария

Репутация: -  0  +


Вот как звучит задача:

Ввести числовую прямоугольную матрицу размером M×N (M и N заданы). Определить элементы, которые, являясь максимальными в столбцах, больше всех своих соседей слева в строке и меньше всех своих соседей справа в строке, указав значения найденных элементов и их индексы, или же сообщить, что таких элементов нет. Крайние столбцы не рассматривать.

Начала делать, но что то не работает толком...помогите пожалуйста


Program Matrix;
const stroka='';
stolb=''; {Ввод констант}
var a:array [1..100,1..100] of integer;
im,jm,i,j,max,n,m,max1:integer;

procedure maxinstolb;{Процедура нахождения максимального элемента в каждом столбце}
begin
for j:=2 to (m-1) do begin
max:=a[1,j];
im:=1; jm:=j;
for i:=1 to n do
if a[i,j]>max then begin
max:=a[i,j];
im:=i;
jm:=j;
end;
end;
end;

procedure maxelement; ;{Процедура проверки условия: максимальный элемент больше всех соседей слева и меньше всех соседей справа }
begin
i:=im;
for j:=1 to (jm-1) do begin
if a[i,j]<max then max1:=max;
end;
for j:=(jm+1) to m do begin
if a[i,j]>max1 then writeln(max,' [',im,';',jm,']')
else writeln('Ne suschestvuet');
end;
end;

begin
writeln(stroka,'Vvedite kol-vo strok matrici');
readln(n);
writeln(stolb,'Vvedite kol-vo stolbcov matrici');
readln(m);
writeln;
writeln('Vvedite ',m*n,' elementa massiva:');
for i:=1 to n do
for j:=1 to m do
read(a[i,j]);

writeln('Ishodnaya matrica');
for i:=1 to n do begin
for j:=1 to m do
write(a[i,j],' ');
writeln;
end;

writeln('Max element boshe vseh sosedey sleva, no menshe vseh sosedey sprava');
maxinstolb;
maxelement;
end.


 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Vinchkovsky
сообщение 8.03.2009 0:38
Сообщение #2


Пионер
**

Группа: Пользователи
Сообщений: 98
Пол: Мужской
Реальное имя: Andriy

Репутация: -  0  +


Ой, я отвечал, но ответ не появился blink.gif

Если кратко, то главные замечания: вы запутались с индексами (у меня столбцы на первом месте, а не на втором), добавил строку в конце, чтобы вы могли увидеть результат, а также убрал мусор с константами.

У меня работает:
Program Matrix1;
uses Crt;
type Matrix=array[1..50,1..50] of integer;
var A:Matrix;
i,j,n,m:integer;

procedure Sort(n,m:integer; A:Matrix);
var i,k,j,Max:integer;
SecondTerm,Exist:boolean;
begin
Exist:=false;

for i:=2 to m-1 do
begin
Max:=A[i,1];
for k:=2 to n do
if A[i,k]>Max then
Max:=A[i,k];

for k:=1 to n do
if A[i,k]=Max then
begin
SecondTerm:=true;
for j:=1 to i-1 do
if A[j,k]>=A[i,k] then SecondTerm:=false;
for j:=i+1 to n do
if A[j,k]<=A[i,k] then SecondTerm:=false;
if SecondTerm then
begin
writeln('st=',i,' r=',k,' ',Max);
Exist:=true;
end;
end;
end;

if not Exist then writeLn('No elements of this kind');
end;



begin
writeln('Vvedite kol-vo strok matrici');
readln(n);
writeln('Vvedite kol-vo stolbcov matrici');
readln(m);
writeln;
writeln('Vvedite ',m*n,' elementa massiva:');
for i:=1 to n do
for j:=1 to m do
read(A[j,i]);

writeln('Ishodnaya matrica');

for i:=1 to n do
begin
for j:=1 to m do
write(A[j,i],' ');
writeln;
end;

Sort(n,m,A);
repeat until Keypressed;

end.

на:
1 2 5 6
1 2 3 4

Извиняйте за отсуствие форматирования - а оно нужно! - не сохранилось.

Удачи wink.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 31.07.2025 17:00
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"