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

Tác giả: flashmt

Ngôn ngữ: Pascal

const maxn=510;
      maxm=8010;
      oo=10000000;
var n,m,q,re,r,nh:longint;
    a,c:array[0..maxm shl 1] of longint;
    sl,pos,cur,h,p,e:array[0..maxn] of longint;
    d:array[1..maxn,1..maxn] of longint;
    b:array[0..maxm,0..2] of longint;
    free:array[0..maxn] of boolean;

procedure rf;
var i:longint;
begin
     read(n,q,m);
     for i:=1 to q do read(e[i]);
     for i:=1 to m do
     begin
          read(b[i,0],b[i,1],b[i,2]);
          inc(sl[b[i,0]]); inc(sl[b[i,1]]);
     end;
     pos[1]:=1; cur[1]:=1;
     for i:=2 to n+1 do
     begin
          pos[i]:=pos[i-1]+sl[i-1];
          cur[i]:=pos[i];
     end;
     for i:=1 to m do
     begin
          a[cur[b[i,0]]]:=b[i,1];
          c[cur[b[i,0]]]:=b[i,2];
          inc(cur[b[i,0]]);
          a[cur[b[i,1]]]:=b[i,0];
          c[cur[b[i,1]]]:=b[i,2];
          inc(cur[b[i,1]]);
     end;
end;

procedure update(z,x:longint);
var cha,con:longint;
begin
     con:=p[x];
     if con=0 then
     begin
          inc(nh); con:=nh;
     end;
     cha:=con shr 1;
     while (cha>0) and (d[z,h[cha]]>d[z,x]) do
     begin
          h[con]:=h[cha];
          p[h[con]]:=con;
          con:=cha; cha:=con shr 1;
     end;
     h[con]:=x; p[x]:=con;
end;

function pop(z:longint):longint;
var x,cha,con:longint;
begin
     pop:=h[1];
     x:=h[nh]; dec(nh);
     cha:=1; con:=2;
     while con<=nh do
     begin
          if (con<nh) and (d[z,h[con+1]]<d[z,h[con]]) then inc(con);
          if d[z,x]<=d[z,h[con]] then break;
          h[cha]:=h[con];
          p[h[cha]]:=cha;
          cha:=con; con:=cha shl 1;
     end;
     h[cha]:=x; p[x]:=cha;
end;

procedure dijk(x:longint);
var i,j,y,u:longint;
begin
     for i:=1 to n do
     begin
          free[i]:=true;
          d[x,i]:=oo;
          p[i]:=0;
          h[i]:=0;
     end;
     d[x,x]:=0;
     nh:=0;
     update(x,x);
     repeat
           y:=pop(x); free[y]:=false;
           for j:=pos[y] to pos[y+1]-1 do
           begin
                u:=a[j];
                if free[u] and (d[x,u]>d[x,y]+c[j]) then
                begin
                     d[x,u]:=d[x,y]+c[j];
                     update(x,u);
                end;
           end;
     until nh=0;
end;

procedure pr;
var i,s,j:longint;
begin
     for i:=1 to q do dijk(e[i]);
     re:=maxlongint;
     for i:=1 to n do
     begin
          s:=0;
          for j:=1 to q do s:=s+d[e[j],i];
          if s<re then
          begin
               re:=s; r:=i;
          end;
     end;
     writeln(r);
end;

begin
     rf;
     pr;
end.

Download