Cod sursa(job #255784)
Utilizator | Data | 10 februarie 2009 16:53:41 | |
---|---|---|---|
Problema | Drumuri minime | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 2.92 kb |
const
inf=1.7e38;
nmax=1500;
type
lista=^elem;
elem=record
v:longint;
c:real;
urm:lista;
end;
var
f,g:text;
d:array[1..1500] of real;
t:array[1..1500] of longint;
c:array[1..1500] of lista;
s:array[1..1500] of 0..1;
n,m,x,y,i,j:longint;
min,ct:real;
p:lista;
ok:boolean;
procedure adauga(x,y:integer;ct:real);
var
p,q:lista;
begin
if c[x]=Nil then begin
new(p);
p^.v:=y;
p^.c:=ln(ct);
p^.urm:=Nil;
c[x]:=p;
end
else begin
p:=c[x];
new(q);
q^.v:=y;
q^.c:=ln(ct);
q^.urm:=p;
c[x]:=q;
end;
if c[y]=Nil then begin
new(p);
p^.v:=x;
p^.c:=ln(ct);
p^.urm:=Nil;
c[y]:=p;
end
else begin
p:=c[y];
new(q);
q^.v:=x;
q^.c:=ln(ct);
q^.urm:=p;
c[y]:=q;
end;
end;
Begin
assign(f,'dmin.in');reset(f);
assign(g,'dmin.out');rewrite(g);
readln(f,n,m);
for i:=1 to n do begin
c[i]:=Nil;
d[i]:=inf;
end;
for i:=1 to m do
begin
readln(f,x,y,ct);
adauga(x,y,ct);
end;
p:=c[1];
while p<>Nil do
begin
d[p^.v]:=p^.c;
t[p^.v]:=1;
p:=p^.urm;
end;
d[1]:=1;
repeat
ok:=false;
min:=inf;
for i:=1 to n do
if (s[i]=0) and (d[i]<min) then
begin
min:=d[i];
y:=i;
ok:=true;
end;
if ok then
begin
s[y]:=1;
p:=c[y];
while p<>Nil do
begin
if s[p^.v]=0 then
begin
if d[p^.v]>d[y]+p^.c then
begin
d[p^.v]:=d[y]+p^.c;
t[p^.v]:=t[y];
end
else if d[p^.v]=d[y]+p^.c then
t[p^.v]:=t[p^.v]+t[y];
end;
p:=p^.urm;
end;
end;
until not ok;
for i:=2 to n do write(g,t[i] mod 104659,' ');
close(f);close(g);
End.