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 I got WAЈїЈїЈї HelpЈЎЈЎ
Posted by XueMao 17 Jul 2002 15:51
Program Image_Encoding;

Const hx:array[1..4] of integer=(1,0,-1,0);
      hy:array[1..4] of integer=(0,1,0,-1);
      g:array[1..4] of char=('R','T','L','B');

Var i,j,k,m,n,k1,k2,tot,t:integer;
    s:string;
    p:set of char;
    b:array[1..2] of integer;
    a,e:array[0..15,1..2] of integer;
    ans:array[0..15,1..4] of integer;
    mark:array[0..15] of integer;

Function Find(c:char):integer;
var i,j:integer;
begin
  j:=0;
  for i:=1 to 4 do
  if g[i]=c then
  begin
    j:=i;
    break;
  end;
  find:=j;
end;


Function Get(x,y:integer):integer;
var i,j:integer;
begin
  j:=0;
  for i:=1 to n do
  if mark[i]=0 then
  if (a[i,1]=x)and(a[i,2]=y) then
  begin
    j:=i;
    break;
  end;
  get:=j;
end;

Procedure Check(x:integer);
var i,j,k,m,n,x1,y1:integer;
begin
  for i:=1 to 4 do
  begin
    x1:=e[x,1]+hx[i];
    y1:=e[x,2]+hy[i];
    k:=get(x1,y1);
    if k<>0 then
    begin
      ans[x,i]:=1;
      mark[k]:=1;
      inc(t);
      e[t,1]:=x1;
      e[t,2]:=y1;
    end;
  end;
end;

Begin
  k:=0;
  while not(eoln) do
  begin
    inc(k);
    read(b[k]);
  end;
  readln;
  fillchar(a,sizeof(a),0);
  fillchar(e,sizeof(e),0);
  fillchar(ans,sizeof(ans),0);
  fillchar(mark,sizeof(mark),0);
  if k<2 then
  begin
    n:=b[1];
    for i:=1 to n do
    readln(a[i,1],a[i,2]);
    e[1,1]:=a[1,1];
    e[1,2]:=a[1,2];
    mark[1]:=1;
    t:=1;
    for i:=1 to n-1 do
    check(i);
    writeln(a[1,1],' ',a[1,2]);
    for i:=1 to n-1 do
    begin
      for j:=1 to 4 do
      if ans[i,j]=1 then write(g[j]);
      writeln(',');
    end;
    writeln('.');
  end
  else
  begin
    e[1,1]:=b[1];
    e[1,2]:=b[2];
    s:='';
    t:=0;
    tot:=1;
    p:=['R','T','L','B'];
    while s<>'.' do
    begin
      readln(s);
      inc(t);
      if s<>'.' then
      begin
        for i:=1 to length(s) do
        if s[i] in p then
        begin
          k:=find(s[i]);
          inc(tot);
          e[tot,1]:=e[t,1]+hx[k];
          e[tot,2]:=e[t,2]+hy[k];
        end;
      end;
    end;
    for i:=1 to tot-1 do
    for j:=i+1 to tot do
    if (e[j,1]<e[i,1])or(e[j,1]=e[i,1])and
    (e[j,2]<e[i,2]) then
    begin
      k:=e[j,1];
      e[j,1]:=e[i,1];
      e[i,1]:=k;
      k:=e[j,2];
      e[j,2]:=e[i,2];
      e[i,2]:=k;
    end;
    writeln(tot);
    for i:=1 to tot do
    writeln(e[i,1],' ',e[i,2]);
  end;
End.