Помощь - Поиск - Пользователи - Календарь
Полная версия: Соседние элементы
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Новичок
Здравствуйте!
Поммогите решить задачу : Определить есть ли в двухмерном массиве одинаковые соседние элементы.

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

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.
Ozzя
А соседние - это как? Соседи по строке или соседи вообще?

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

Для центральной двойки соседи или нет?
volvo
Что такое "соседние элементы в матрице", можно узнать? Элемент A[1, 1] и A[2, 1] (один столбец, между прочим) - соседние?
Lapp
Цитата(Новичок @ 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.

Под "соседними" я понимал соседние по строке или столбцу (не по диагонали). Надеюсь, это то, что тебе надо.
Lapp
Гм. Полезно все же просматривать свои мессаджи.. В приведенном выше коде есть ошибка ((. Точнее, не совсем ошибка, ибо результат все же будет правильный, а скорее неэффективность.
Нужно вот так:
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
TarasBer
> Кстати сказать - выход из двойного (или больше) цикла - это, пожалуй, единственная ситуация, зароняющая мне в душу сомнения насчет правильности полного отрицания goto )).

Я бы в данном случае поставил goto, нисколько не задумываясь и не стесняясь. Другой вопрос, полезно ли учить этому новичков.
Archon
А я бы сделал цикл 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.
Lapp
Цитата(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.

Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.