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

Обсуждение задачи 1250. Захоронения в океане

what's wrong with my program?
Послано Lin 21 мар 2003 17:49
Const Size      = 500+1;
      Dx        : Array[1..8] of Integer=(0,0,-1,1,-1,1,-1,1);
      Dy        : Array[1..8] of Integer=(-1,1,0,0,-1,1,1,-1);

Type mapType    = Array[0..Size,0..Size] of Char;
     BType      = Array[0..Size,0..Size] of Byte;
     setType    = Set of Char;
     arr        = array[1..Size*8,1..2] of Integer;

Var  map        : mapType;
     n,m        : Integer;
     seax,seay  : Integer;

     b          : Btype;
     ans        : Integer;

Procedure Read_data;
Var  i,j        : Integer;
     temp       : Char;
Begin
  Fillchar(b,sizeof(b),0);
  Fillchar(map,sizeof(map),0);
  Readln(m,n,seay,seax);
  For i := 1 to N do Begin
    For j := 1 to M do
      Read(map[i,j]);
    Readln;
  End;
End;

Procedure Mark(x,y : Integer;mapset : setType;t_d : Integer);
Var q              : array[0..1] of arr;
    t              : array[0..1] of Integer;
    p,i,j,tx,ty    : Integer;
Begin
  If b[x,y]<>0 then Exit
               else b[x,y] := 1;
  t[0] := 1; p := 0;
  q[0][1,1] := x; q[0][1,2] := y;
  While t[p]>0 do Begin
    t[1-p] := 0;
    For i := 1 to t[p] do
      For j := 1 to t_d do Begin
        tx := q[p][i,1]+dx[j]; ty := q[p][i,2]+dy[j];
        If (tx>0) and (tx<=N) and (ty>0) and (ty<=M) and
           (b[tx,ty]=0) and (map[tx,ty] in mapset) then Begin
          Inc(t[1-p]);
          q[1-p][t[1-p],1] := tx;
          q[1-p][t[1-p],2] := ty;
          b[tx,ty] := 1;
        End;
      End;
    p := 1-p;
  End;
End;

Procedure Solve;
Var i,j         : Integer;
    mapset      : setType;
Begin
  ans := 0;
  If map[seax,seay]<>'.' then Exit;
  mapset := ['.'];
  Mark(seax,seay,mapset,8);

  mapset := ['#','.'];
  For i := 1 to N do
    For j := 1 to M do
      If b[i,j]=0 then
        If (i=1) or (i=N) or (j=1) or (j=M) then
          Mark(i,j,mapset,4);

  mapset := ['#'];
  For i := 1 to N do
    For j := 1 to M do
      If (map[i,j]='#') and (b[i,j]=0) then Begin
        Inc(ans);
        Mark(i,j,mapset,4);
      End;
End;

Begin
  Read_data;
  Solve;
  Writeln(ans);
End.