BESTSPOT - Vị trí tốt nhất

Tác giả: ladpro98

Ngôn ngữ: Pascal

program bestspot;
uses    math;
type    e=record
        v,w,link:longint;
        end;
const   maxn=555;
        maxm=16003;
        fi='';
        oo=trunc(1e7);
var     head,des,d,q:array[0..maxn] of longint;
        inq:array[1..maxn] of boolean;
        adj:array[1..maxm] of e;
        n,f,c,m,res,choose,nq:longint;

procedure input;
var     inp:text;
        i,x,w,y:longint;
begin
        assign(inp,fi);reset(inp);
        readln(inp,n,f,c);
        for i:=1 to f do readln(inp,des[i]);
        for i:=1 to c do
        begin
                readln(inp,x,y,w);
                inc(m);
                adj[m].v:=y;
                adj[m].w:=w;
                adj[m].link:=head[x];
                head[x]:=m;
                inc(m);
                adj[m].v:=x;
                adj[m].w:=w;
                adj[m].link:=head[y];
                head[y]:=m;
        end;
        close(inp);
end;

procedure BellmanFord(g:longint);
var     u,i,l,r:longint;
        v:e;
begin
        for i:=1 to n do
        begin
                d[i]:=oo;
                inq[i]:=false;
        end;
        l:=0;r:=0;
        q[0]:=g;
        nq:=1;
        d[g]:=0;
        repeat
                u:=q[l];
                l:=(l+1) mod maxn;dec(nq);
                inq[u]:=false;
                i:=head[u];
                while i>0 do
                begin
                        v:=adj[i];
                        if d[v.v]>d[u]+v.w then
                        begin
                                d[v.v]:=d[u]+v.w;
                                if not inq[v.v] then
                                begin
                                        inq[v.v]:=true;
                                        r:=(r+1) mod maxn;
                                        inc(nq);
                                        q[r]:=v.v;
                                end;
                        end;
                        i:=v.link;
                end;
        until nq=0;
end;

procedure process;
var     i,j,sum:longint;
begin
        res:=high(longint);
        for i:=1 to n do
        begin
                BellmanFord(i);
                sum:=0;
                for j:=1 to f do
                inc(sum,d[des[j]]);
                if sum<res then
                begin
                        res:=sum;
                        choose:=i;
                end;
        end;
end;

begin
        input;
        process;
        write(choose);
end.

Download