ENG  RUS Timus Online Judge
Online Judge
Problems
Authors
Online contests
Site news
Webboard
Problem set
Submit solution
Judge status
Guide
Register
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.
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
for i:=1 to n do
begin
for j:=1 to k[i] do
begin
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;
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~!