# Cod sursa(job #50515)

Utilizator Data 7 aprilie 2007 20:31:47 Drumuri minime 5 fpc done Arhiva de probleme 2.36 kb
``````{\$N+}

const maxn = 1001;
inf = 2000000000;
baza = 2;
eps = 0.00001;
modul = 104659;

type lista = ^list;
list = record
nod:longint;
next:lista;
end;

var f:text;
n,m,i,len:longint;
j:double;
c:array[1..maxn,0..maxn]of longint;
st,sol:array[1..maxn]of longint;
d:array[1..maxn,1..maxn]of double;
dist:array[1..maxn]of double;
fol:array[1..maxn]of boolean;

var aux:lista;
begin
new(aux);
aux^:=c[y]^;
if fol[y]=true then
begin
aux:=nil;
fol[y]:=false;
end;
c[y]^.nod:=x;
c[y]^.next:=aux;
end;                        }

function log(x:double):double;
var y,p:double;
v,t:double;
begin
y:=baza;
p:=baza;
v:=1;
t:=1;
if x=y then
begin
log:=1;
exit;
end;
while abs(y*p/x-1)>eps do
begin
while y*p-x<eps do
begin
v:=v+t;
y:=y*p;
end;
if abs(y-x)<eps then
begin
break;
end;
p:=sqrt(p);
t:=t/2;
end;
if y*baza=x then v:=v+1;
log:=v;
end;

begin
inc(c[x,0]);
c[x,c[x,0]]:=y;
d[x,y]:=j;
end;

var x,y:longint;
begin
assign(f,'dmin.in');
reset(f);
{   for i:=1 to n do
begin
new(c[i]);
fol[i]:=true;
end;          }
for i:=1 to m do
begin
j:=log(j);
end;
close(f);
end;

procedure relax(u,v:longint);
begin
if dist[v]>dist[u]+d[u,v] then
begin
dist[v]:=dist[u]+d[u,v];
inc(len);
st[len]:=v;
sol[v]:=0;
end;
if abs(dist[v]-(dist[u]+d[u,v]))<eps then
begin
sol[v]:=(sol[v]+sol[u]) mod modul;
end;
end;

procedure solve;
var aux:lista;
j:longint;
begin
for i:=1 to n do dist[i]:=inf;
len:=1;
st[1]:=1;
dist[st[1]]:=0;
i:=1;
sol[1]:=1;
while i<=len do
begin
for j:=1 to c[st[i],0] do
begin
relax(st[i],c[st[i],j]);
end;
inc(i);
end;
end;

procedure writedata;
begin
assign(f,'dmin.out');
rewrite(f);
for i:=2 to n-1 do write(f,sol[i],' ');
writeln(f,sol[n]);
close(f);
end;

begin