задача про фотографию, двумерный массив является цветной фотографией Опции

[oleg]

Двумерный массив является "цветной фотографией", каж-
дый его элемент - номер цвета некоторой точки (от 1 до некото-
рого значения Max).
Будем считать, что если два элемента стоят рядом по
вертикали или по горизонтали и имеют одинаковый цвет, то они
принадлежат одной области. (Вся область определяется рефлек-
сивно-транзитивным замыканием этого отношения.)
Требуется найти количество разных цветных областей.
Запрещается пользоваться метками!

P.S до зачета три дня

Сообщение отредактировано: oleg - 3.01.2006 15:51

[virt]

Код

program num_obl;
const maxN = 10;
var a : array[0..maxN + 1,0..maxN + 1]of byte;
    i,j,n : integer;
    cou : integer = 0;
    col : byte;

procedure flood(ii,jj : integer);
begin
   if a[ii,jj] <> col then exit;
   a[ii,jj] := 0;
   flood(ii - 1,jj);
   flood(ii + 1,jj);
   flood(ii,jj - 1);
   flood(ii,jj + 1);
end;

begin
   readln(n);
   fillchar(a,sizeof(a),0);
   for i := 1 to n do
      for j := 1 to n do
         read(a[i,j]);
   for i := 1 to n do
      for j := 1 to n do
         if a[i,j] <> 0 then
            begin
               cou := cou + 1;
               col := a[i,j];
               flood(i,j);
            end;
   writeln(cou);
end.

вот ,вроде так

[oleg]

мне кажется, что тоже. Большое спасибо!

Сообщение отредактировано: oleg - 4.01.2006 11:19

[volvo]

Вот так попробуй (проверка выхода за пределы массива никогда не была лишней !!!):

program num_obl;
const maxN = 5;
type
  arr = array[1..maxN, 1..maxN] of integer;
const
  a: arr =
    (
    (1, 0, 0, 0, 1),
    (0, 1, 1, 1, 0),
    (0, 1, 0, 1, 0),
    (0, 1, 0, 1, 0),
    (1, 0, 0, 0, 1)
    );
var
  i,j,n : integer;
  cou : integer = 0;
  col : byte;

procedure flood(ii,jj : integer);
begin
   if (a[ii,jj] <> col)
      or
      (ii < 1) or (jj < 1) or (ii > n) or (jj > n)
   then exit;
   a[ii,jj] := -1;
   flood(ii - 1,jj);
   flood(ii + 1,jj);
   flood(ii,jj - 1);
   flood(ii,jj + 1);
end;

begin
  n := maxN;
  for i := 1 to n do
    for j := 1 to n do
      if a[i,j] <> -1 then begin
        cou := cou + 1;
        col := a[i,j];
        flood(i,j);
      end;
  writeln(cou);
end.

[Гость]

Мужики а почему
writeln(cou)
а не writeln(cou-1)

[volvo]

А почему Cou-1? Здесь же нет фона, если будет только один цвет - это значит не 0, а 1 область...

[Гость]

А ты результат посмотри выполнения

[volvo]

А ты думаешь, я свой вариант программы выложил, не проверив ВСЕ тесты автора? То, что он сказал, то и получил. А ты что, его адвокат? Какое отношение ТЫ к вопросу имеешь? Ты еще за автора будешь решать, что ему подойдет, а что - нет?

Кстати, при прогоне программы из поста №4 на матрице

const
  a: arr =
    (
    (0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0),
    (0, 0, 0, 0, 0)
    );

Выдается результат:

Running "f:\vlady documents\programs\pas\__4554.exe /sum 20.5 63.2"
1

Что я делаю неправильно?

А ты прогонял, чтобы претензии высказывать? И потом, ты считаешь, что результат неправильный, чего же ты НИ РАЗУ ни одно правильное решение не запостил? Кстати, ты ВООБЩЕ никакое не постишь... Нехорошо.

[virt]

var a : array[0..maxN + 1,0..maxN + 1]of byte;

там проверка на выход за переделы есть