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