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

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

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

 
 Ответить  Открыть новую тему 
> Соседние элементы
сообщение
Сообщение #1


Новичок
*

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

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


Здравствуйте!
Поммогите решить задачу : Определить есть ли в двухмерном массиве одинаковые соседние элементы.

В одномерных массивах я использовал такой способ

for i:=1 to n-1
if a[i]=a[i+1] then write ('yes') else write ('no')


но в двухмерных он наверное не пройдёт
ниже текст всей задачи

program f323;
const n=3;
var a:array [1..n,1..n] of integer;
i,j:integer;
begin
for i:=1 to n do
for j:=1 to n do
read (a[i,j]);
for i:=1 to n do begin
for j:=1 to n do write (a[i,j]:5);
writeln end;
for i:=1 to n-1 do
for j:=1 to n-1 do
if a[i,j]= a[i+1,j+1] then writeln ('есть)
else write('нет');
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 220
Пол: Мужской

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


А соседние - это как? Соседи по строке или соседи вообще?

Цитата
2 2 2
2 2 2
2 2 2

Для центральной двойки соседи или нет?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Что такое "соседние элементы в матрице", можно узнать? Элемент A[1, 1] и A[2, 1] (один столбец, между прочим) - соседние?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Новичок @ 5.04.2010 16:50) *
Определить есть ли в двухмерном массиве одинаковые соседние элементы.

Примерно так:
var
Answer: string;
.... // другие переменные

begin
.... // запонение матрицы
Answer:='no';
for i:=2 to n do for j:=2 to m do if (a[i,j]=a[i-1,j])or(a[i,j]=a[i,j-1]) then begin
Answer:='yes';
break
end;
WriteLn(Anwer)
end.

Под "соседними" я понимал соседние по строке или столбцу (не по диагонали). Надеюсь, это то, что тебе надо.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Гм. Полезно все же просматривать свои мессаджи.. В приведенном выше коде есть ошибка ((. Точнее, не совсем ошибка, ибо результат все же будет правильный, а скорее неэффективность.
Нужно вот так:
var
Answer: string;
.... // другие переменные

begin
.... // запонение матрицы
Answer:='no';
for i:=2 to n do begin
for j:=2 to m do if (a[i,j]=a[i-1,j])or(a[i,j]=a[i,j-1]) then begin
Answer:='yes';
break
end;
if Answer='yes' then break
end;
WriteLn(Answer)
end.

Либо вот так:
var
Answer: boolean;
.... // другие переменные

begin
.... // запонение матрицы
Answer:=false;
for i:=2 to n do begin
for j:=2 to m do begin
Answer:=(a[i,j]=a[i-1,j])or(a[i,j]=a[i,j-1]);
if Answer then break
end;
if Answer then break
end;
if Answer then WriteLn('yes') else WriteLn('no')
end.

Кстати сказать - выход из двойного (или больше) цикла - это, пожалуй, единственная ситуация, зароняющая мне в душу сомнения насчет правильности полного отрицания goto )). Было бы, кстати, удобно иметь что-то типа break(n) , где n - это на сколько уровней вверх.
Можно, конечно, сделать через функцию, и в ней пользовать exit вместо break .. smile.gif


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Злостный любитель
*****

Группа: Пользователи
Сообщений: 1 755
Пол: Мужской

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


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

Я бы в данном случае поставил goto, нисколько не задумываясь и не стесняясь. Другой вопрос, полезно ли учить этому новичков.


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Профи
****

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

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


А я бы сделал цикл while или repeat. Break, имхо, почти так же некрасиво, как и goto.
Цитата
Гм. Полезно все же просматривать свои мессаджи.. В приведенном выше коде есть ошибка ((. Точнее, не совсем ошибка, ибо результат все же будет правильный, а скорее неэффективность.
Все же есть еще одна ошибка, и результат правильным будет не всегда =). Например, попробуй массив
5 5 5 5 5
5 6 7 8 9
5 2 3 4 5
5 6 7 8 1

Мой вариант:
. . . { Объявление переменных }
begin
. . . { Заполнение массива }
Answer := false;
{ Проверяем горизонтальные пары: }
j := 1;
while not Answer and (j <= m) do begin
i := 1;
while not Answer and (i < n) do begin
Answer := a[i, j] = a[i + 1, j];
Inc(i);
end;
Inc(j);
end;
{ Проверяем вертикальные пары: }
i := 1;
while not Answer and (i <= n) do begin
j := 1;
while not Answer and (j < m) do begin
Answer := a[i, j] = a[i, j + 1];
Inc(j);
end;
Inc(i);
end;
if Answer then WriteLn('yes') else WriteLn('no');
end.
или
. . . { Объявление переменных }
begin
. . . { Заполнение массива }
Answer := false;
j := 1;
while not Answer and (j <= m) do begin
i := 1;
while not Answer and (i <= n) do begin
if i <> n then Answer := a[i, j] = a[i + 1, j];
if not Answer and (j <> m) then Answer := a[i, j] = a[i, j + 1];
Inc(i);
end;
Inc(j);
end;
if Answer then WriteLn('yes') else WriteLn('no');
end.


--------------------
Close the World...txeN eht nepO
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Archon @ 7.04.2010 18:13) *
Все же есть еще одна ошибка, и результат правильным будет не всегда =).
Да, есть ошибка, верно. Sorry ((.

Извиняюсь и исправляюсь:
const
n= 5;
m= 5;

type
tMatrix = array[1..n,1..m]of integer;

function Answer(var a: tMatrix): boolean;
var
i,j,b: integer;
begin
Answer:=false;
for i:=1 to n do for j:=1 to m do begin
b:= a[i,j];
if (i>1)and(b=a[i-1,j])or(j>1)and(b=a[i,j-1])or(i<n)and(b=a[i+1,j])or(j<m)and(b=a[i,j+1])
then begin
Answer:= true;
Exit
end
end
end;

var
a: tMatrix;
i,j: integer;

begin
Randomize;
for i:=1 to n do for j:=1 to m do a[i,j]:=Random(m*n);
for i:=1 to n do begin
for j:=1 to m do Write(a[i,j]:4);
WriteLn
end;
if Answer(a) then WriteLn('yes') else WriteLn('no')
end.



--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 25.04.2024 10:43
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name