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.