ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1121. Филиалы

Help, WA! Give me some test please!
Послано Algorithmus_UA(algorithmus@univ.kiev.ua) 4 ноя 2002 03:00
const MAXN = 150;
type  pointtype = record
                    x,y:byte;
                  end;
var a,b:array[1..MAXN,1..MAXN]of integer;
    c:array[1..MAXN,1..MAXN]of byte;
    s1,s2:array[1..10000]of pointtype;
    N,M,h1,h2,tek,i,j:integer;
procedure rec(x,y,k:byte);
begin
  if (x=0)or(y = 0)or(x = N+1)or(Y = M+1) then exit;
  if (a[x,y] = 0)and((c[x,y] = 0)or(c[x,y] = tek)) then
  begin
    b[x,y]:=b[x,y] or k;
    if c[x,y] = 0 then
    begin
      c[x,y]:=tek;
      inc(h2);
      s2[h2].x:=x;s2[h2].y:=y;
    end;
  end;
end;

begin
{ assign(input,'1121.dat');reset(input);}
  readln(N,M);
  for i:=1 to N do for j:=1 to M do read(a[i,j]);
  for i:=1 to N do for j:=1 to M do if a[i,j]<>0 then
  begin
     inc(h1);
     s1[h1].x:=i;s1[h1].y:=j;{s1[h1].k:=a[i,j];}
     b[i,j]:=a[i,j];
  end;
  tek:=0;
  while true do
  begin
     inc(tek);if tek = 6 then break;
     if h1 = 0 then break;
     h2:=0;
     for i:=1 to h1 do
     begin
       rec(s1[i].x+1,s1[i].y,b[s1[i].x,s1[i].y]);
       rec(s1[i].x-1,s1[i].y,b[s1[i].x,s1[i].y]);
       rec(s1[i].x,s1[i].y-1,b[s1[i].x,s1[i].y]);
       rec(s1[i].x,s1[i].y+1,b[s1[i].x,s1[i].y]);
     end;
     h1:=h2;
     for i:=1 to h1 do s1[i]:=s2[i];
  end;
  for i:=1 to N do
  begin
    for j:=1 to M-1 do
    begin
      if a[i,j] = 0 then write(b[i,j],' ')
      else write(-1,' ');
    end;
    if a[i,M] = 0 then writeln(b[i,M])
    else writeln(-1);
  end;
end.