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

Обсуждение задачи 1008. Кодирование изображений

Why does my program always get Wrong Answer?! HELP!!!
Послано Zhou Yuan 6 окт 2001 13:10
Const
    InFile    = '1008.in';
    OutFile    = '1008.out';
    N    = 11;

Type
    Tmap    = array[0..N , 0..N] of boolean;
    Tqueue    = array[1..N * N , 1..2] of integer;

Var
    queue    : Tqueue;
    map    : Tmap;
    open ,
    closed    : integer;

procedure init;
var
    M , i ,
    j , k    : integer;
begin
    fillchar(map , sizeof(map) , 0);
{    assign(INPUT , InFile); ReSet(INPUT);}
      readln(M);
      for i := 1 to M do
        begin
            readln(j , k);
            map[j , k] := true;
        end;
{    Close(INPUT);}
end;

procedure bfs(i , j : integer);
var
    x , y    : integer;
begin
    fillchar(queue , sizeof(queue) , 0);
    open := 1; closed := 1; queue[1 , 1] := i; queue[1 ,
2] := j;
    while open <= closed do
      begin
          x := queue[open , 1]; y := queue[open , 2];
          if map[x + 1 , y] then
            begin inc(closed); queue[closed , 1] := x + 1;
queue[closed , 2] := y; write('R'); end;
          if map[x , y + 1] then
            begin inc(closed); queue[closed , 1] := x; queue
[closed , 2] := y + 1; write('T'); end;
          if map[x - 1 , y] then
            begin inc(closed); queue[closed , 1] := x - 1;
queue[closed , 2] := y; write('L'); end;
          if map[x , y - 1] then
            begin inc(closed); queue[closed , 1] := x; queue
[closed , 2] := y - 1; write('B'); end;
          map[x + 1 , y] := false; map[x , y - 1] := false;
          map[x - 1 , y] := false; map[x , y + 1] := false;
          inc(open);
          if open > closed then
            writeln('.')
          else
            writeln(',');
      end;
end;

procedure work;
var
    i , j    : integer;
begin
    for i := 1 to N do
      for j := 1 to N do
        if map[i , j] then
          begin
              writeln(i , ' ' , j);
              map[i , j] := false;
              bfs(i ,j);
          end;
end;

Begin
    init;
{    assign(OUTPUT , OutFile); ReWrite(OUTPUT);}
      work;
{    Close(OUTPUT);}
End.