ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1008. Image Encoding

Why does my program always get Wrong Answer?! HELP!!!
Posted by Zhou Yuan 6 Oct 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.