ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1072. Маршрутизация

WA 5#
Послано Gdp 21 апр 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~!