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 1072. Routing

WA 5#
Posted by Gdp 21 Apr 2010 09:17
It is my program.
program sad;
var
tu:array[1..100,1..100] of int64;
d,p:array[1..1000] of int64;
f:array[1..1000] of boolean;
k,pre,pree:array[1..1000] of int64;
a:array[1..90,1..6,1..8] of int64;
ii,jj,w,i,j,m,n,u,v,bit,l,r,t,q,sum,g,i1,i2,i3,i4,n1,n2,n3,n4:longint;
c:char;s:string;

function pd:boolean;
var w:longint;
begin
for w:=1 to 4 do
if  a[i,j,w]<>a[ii,jj,w] then exit(false);
exit(true);
end;




procedure spfa(s:longint);
var i,j,k,h,t,x:longint;
begin

fillchar(f,sizeof(f),false);
fillchar(p,sizeof(p),0);
for i:=1 to n do
d[i]:=maxlongint shr 1;
f[s]:=true;
t:=1;
h:=0;
d[s]:=0;
p[t]:=s;
 while h<>t do
 begin
h:=(h mod n)+1;
x:=p[h]; f[x]:=false;
for j:=1 to n do
  if (tu[x,j]<>0) and   (d[x]+tu[x,j]<d[j])  then
  begin
  d[j]:=d[x]+tu[x,j];
  if not f[j] then
  begin
  t:=(t mod n) +1;  p[t]:=j; f[j]:=true;
  pre[j]:=x;
  end;
  end;
 end;
end;


begin
readln(n);
for i:=1 to n do
begin
readln(k[i]);
for j:=1 to k[i] do
begin
readln(s);
g:=pos('.',s);val(copy(s,1,g-1),i1);delete(s,1,g);
g:=pos('.',s);val(copy(s,1,g-1),i2);delete(s,1,g);
g:=pos('.',s);val(copy(s,1,g-1),i3);delete(s,1,g);
g:=pos(' ',s);val(copy(s,1,g-1),i4);delete(s,1,g);
g:=pos('.',s);val(copy(s,1,g-1),n1);delete(s,1,g);
g:=pos('.',s);val(copy(s,1,g-1),n2);delete(s,1,g);
g:=pos('.',s);val(copy(s,1,g-1),n3);delete(s,1,g);
val(s,n4);
a[i,j,1]:=i1 and n1;
a[i,j,2]:=i2 and n2;
a[i,j,3]:=i3 and n3;
a[i,j,4]:=i4 and n4;
end;
end;
for i:=1 to n do
for ii:=1 to n do
for j:=1 to k[i] do
for jj:=1 to k[ii] do
begin
if not pd then break;
tu[i,ii]:=1;
tu[ii,i]:=1;
end;
readln(l,r);
spfa(l);
q:=r;
sum:=0;
while q<>0 do
begin
inc(sum);
pree[sum]:=q;
q:=pre[q];
end;
if (sum>1) and (sum<>0) then begin
writeln('Yes');
for i:=sum downto 1 do
write(pree[i],' '); end else
write('No');
writeln;
end.

WA at 5# ~~
Help me~!