# Cod sursa(job #255767)

Utilizator Data 10 februarie 2009 16:33:02 Drumuri minime 0 fpc done Arhiva de probleme 1.79 kb
``````const inf=2000000000;
const nmax=1501;
type lista=^elem;
elem=record
v,c:longint;
end;

var poz,d,viz:array[1..nmax] of longint;
a:array[1..nmax] of lista;
c:array[1..4*nmax]of longint;
q:lista;
f,g:text;
min,ct,i,j,x,pc,uc,y,n,m:longint;
ok:boolean;
begin
assign(f,'dmin.in');
reset(f);
assign(g,'dmin.out');
rewrite(g);
for i:=1 to m do
begin
new(q);
q^.c:=ct;
q^.v:=y;
a[x]:=q;
end;

for i:=2 to n do
begin
d[i]:=inf;
{  poz[i]:=1;  }
end;
q:=a[1];
while q<>NIL do
begin
d[q^.v]:=q^.c;
poz[q^.v]:=1;
end;
d[1]:=1;
poz[1]:=1;
viz[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;