Помощь - Поиск - Пользователи - Календарь
Полная версия: Соседние элементы
Форум «Всё о Паскале» > 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.

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