BESTSPOT – SPOJ

Đề bài: http://vn.spoj.com/problems/BESTSPOT/

Thuật toán:

• (đang cập nhập)

Code:

{$MODE OBJFPC}
Const
        fi      ='';
        fo      ='';
        maxn    =10000;
        maxm    =100000;
        maxw    =1000000000;

Type
        Arr1    =array[0..maxn] of longint;
        Arr2    =array[0..2*maxm] of longint;
        tHeap   =record
          val   :Arr1;
          pos   :Arr1;
          nheap :longint;
        end;

Var
        n,m,x   :longint;
        p       :Arr1;
        d       :Arr1;
        head    :arr1;
        link,adj:arr2;
        t       :arr2;
        heap    :theap;
        kq      :longint;
        best    :longint;
        dm      :longint;
        f       :text;

Procedure ae(u,v,w:longint);
begin
        inc(dm);
        adj[dm]:=v;
        t[dm]:=w;
        link[dm]:=head[u];
        head[u]:=dm;
end;

Procedure Nhap;
var
        i,u,v,w :longint;
begin
        assign(f,fi);
        reset(f);
        readln(f,n,x,m);
        dm:=0;
        best:=maxlongint;
        for i:=1 to n do head[i]:=0;
        for i:=1 to x do readln(f,p[i]);
        for i:=1 to m do
          begin
            readln(f,u,v,w);
            ae(u,v,w);
            ae(v,u,w);
          end;
        close(f);
end;

Procedure InitHeap(s:longint);inline;
var
        i       :longint;
begin
        With Heap do
          begin
            nheap:=1;
            for i:=1 to n do
              begin
                pos[i]:=0;
                d[i]:=maxw;
              end;
            val[1]:=s;
            pos[s]:=1;
            d[s]:=0;
          end;
end;

Function getmin:longint;inline;
var
        v       :longint;
        cha,con :longint;
begin
        With Heap do
          begin
            if nheap=0 then exit(0);
            GetMin:=val[1];
            v:=val[nheap];
            cha:=1;
            dec(nheap);
            repeat
              con:=2*cha;
              if (connheap) or (d[val[con]]>=d[v]) then break;
              val[cha]:=val[con];
              pos[val[con]]:=cha;
              cha:=con;
            until false;
            val[cha]:=v;
            pos[v]:=cha;
          end;
end;

Procedure Update(v:longint);inline;
var
        cha,con :longint;
begin
        With Heap do
          begin
            con:=pos[v];
            if con=0 then
              begin
                inc(nheap);
                con:=nheap;
              end;
            repeat
              cha:=con div 2;
              if (cha=0) or (d[val[cha]]<=d[v]) then break;
              val[con]:=val[cha];
              pos[val[cha]]:=con;
              con:=cha;
            until false;
            val[con]:=v;
            pos[v]:=con;
          end;
end;

Procedure Dijkstra(s:longint);
var
        i,u,v   :longint;
        ss      :longint;
begin
        InitHeap(s);
        repeat
          u:=getmin;
          if u=0 then break;
          i:=head[u];
          while i<>0 do
            begin
              v:=adj[i];
              if d[v]>d[u]+t[i] then
                begin
                  d[v]:=d[u]+t[i];
                  update(v);
                end;
              i:=link[i];
            end;
        until false;
        ss:=0;
        for i:=1 to x do
          if d[p[i]]=maxw then exit
            else ss:=ss+d[p[i]];
        if (sss)) then
          begin
            best:=ss;
            kq:=s;
          end;
end;

Procedure Sol;
var
        i       :longint;
begin
        For i:=1 to n do Dijkstra(i);
end;

Procedure Xuat;
begin
        assign(f,fo);
        rewrite(f);
        write(f,kq);
        close(f);
end;

begin
        Nhap;
        sol;
        xuat;
end.