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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
mashka-promakashka
сообщение 7.03.2009 23:02
Сообщение #2


Новичок
*

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

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


Код
Program Matrix1;
const stroka='';
      stolb='';

     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(stroka,'Vvedite kol-vo strok matrici');
     readln(m);
     writeln(stolb,'Vvedite kol-vo stolbcov matrici');
     readln(n);
     writeln;
     writeln('Vvedite ',m*n,' elementa massiva:');
     for i:=1 to m do
     for j:=1 to n do
     read(A[i,j]);

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

Sort(n,m,A);


         end.


Сделала вроде все как вы сказали, но не работает sad.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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


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

 



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