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

Tác giả: RR

Ngôn ngữ: Pascal

//Written by Nguyen Thanh Trung
{$R+,Q+}
{$Mode objFPC}
uses math;
const
  FINP          =       '';
  FOUT          =       '';
  MAXN          =       555;
  oo            =       1000111000;
type
  list          =       ^node;
  node          =       record
                                u,c:longint;
                                next:list;
                        end;
  Theap         =       object
        val     :       array[1..MAXN] of longint;
        pos     :       array[1..MAXN] of longint;
        size    :       longint;
        function lower(a,b:longint):boolean;
        procedure down(i:longint);
        procedure up(i:longint);
        procedure push(u:longint);
        procedure pop(var u:longint);
  end;
var
  f1,f2         :       text;
  n,sp          :       longint;
  p             :       array[1..MAXN] of longint;
  ke            :       array[1..MAXN] of list;
  heap          :       Theap;
  d,sum         :       array[1..MAXN] of longint;

procedure openF;
    begin
      assign(f1,FINP); reset(f1);
      assign(f2,FOUT); rewrite(f2);
    end;
procedure closeF;
    begin
      close(f1);
      close(f2);
    end;
procedure add(u,c:longint; var a:list); inline;
    var
      p:list;
    begin
      new(p); p^.u:=u; p^.c:=c;
      p^.next:=a; a:=p;
    end;
procedure inp;
    var
      m,u,v,c:longint;
    begin
      read(f1,n,sp,m);
      for u:=1 to sp do
        read(f1,p[u]);
      for m:=1 to m do
        begin
          read(f1,u,v,c);
          add(v,c,ke[u]);
          add(u,c,ke[v]);
        end;
    end;
function Theap.lower(a,b:longint):boolean; inline;
    begin
      exit(d[val[a]]<d[val[b]]);
    end;
procedure swap(var a,b:longint); inline;
    var
      temp:longint;
    begin
      temp:=a; a:=b; b:=temp;
    end;
procedure Theap.down(i:longint);
    var
      j:longint;
    begin
      j:=i<<1;
      while (j<=size) do
        begin
          if (j<size) and lower(j+1,j) then inc(j);
          if lower(j,i) then
            begin
              swap(pos[val[i]],pos[val[j]]);
              swap(val[i],val[j]);
            end
          else exit;
          i:=j; j:=i<<1;
        end;
    end;
procedure Theap.up(i:longint);
    var
      j:longint;
    begin
      j:=i>>1;
      while (i>1) and lower(i,j) do
        begin
          swap(pos[val[i]],pos[val[j]]);
          swap(val[i],val[j]);
          i:=j; j:=i>>1;
        end;
    end;
procedure Theap.push(u:longint);
    begin
      inc(size); val[size]:=u; pos[u]:=size;
      up(size);
    end;
procedure Theap.pop(var u:longint);
    begin
      u:=val[1]; pos[u]:=0;
      swap(val[1],val[size]); pos[val[1]]:=1;
      dec(size); down(1);
    end;
procedure ijk(start:longint);
    var
      u,v,c:longint;
      p:list;
    begin
      for u:=1 to n do d[u]:=oo;
      with heap do
        begin
          size:=0;
          fillchar(pos,sizeof(pos),0);
        end;
      d[start]:=0; heap.push(start);
      while heap.size>0 do
        begin
          heap.pop(u);
          p:=ke[u];
          while p<>nil do
            begin
              v:=p^.u; c:=p^.c; p:=p^.next;
              if d[v]>d[u]+c then
                begin
                  d[v]:=d[u]+c;
                  if heap.pos[v]=0 then heap.push(v)
                  else heap.up(heap.pos[v]);
                end;
            end;
        end;
    end;
procedure update;
    var
      u:longint;
    begin
      for u:=1 to n do
        inc(sum[u],d[u]);
    end;
procedure solve;
    var
      i:longint;
    begin
      for i:=1 to sp do
        begin
          ijk(p[i]);
          update;
        end;
    end;
procedure ans;
    var
      best,i:longint;
    begin
      best:=1;
      for i:=2 to n do
        if sum[i]<sum[best] then best:=i;
      writeln(f2,best);
    end;

begin
  openF;
  inp;
  solve;
  ans;
  closeF;
end.

Download