REVAMP - Revamping Trails

Tác giả: ladpro98

Ngôn ngữ: Pascal

{$MODE OBJFPC}
program REVAMP;
uses    math;
const   maxn=10001;
        maxm=100005;
        maxk=21;
        oo=trunc(1e9);
        fi='';
        fo='';
type    e =record
        v,w,link:longint;
        end;
        xy=record
        x,y:longint;
        end;
var     n,m,k,nh,mm:longint;
        adj:array[1..maxm] of e;
        head:array[1..maxn] of longint;
        pos,d:array[1..maxn,0..maxk] of longint;
        h:array[1..maxn*maxk] of xy;

procedure input;
var     inp:text;
        i,x,y,w:longint;
begin
        assign(inp,fi);reset(inp);
        readln(inp,n,mm,k);
        for i:=1 to mm 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 update(i,j:longint);
var     p,c:longint;
begin
        c:=pos[i,j];
        if c=0 then
        begin
                inc(nh);
                c:=nh;
        end;

        repeat
                p:=c div 2;
                if (p=0) or (d[h[p].x,h[p].y]<=d[i,j]) then break;
                h[c]:=h[p];
                pos[h[c].x,h[c].y]:=c;
                c:=p;
        until false;
        h[c].x:=i;h[c].y:=j;
        pos[i,j]:=c;
end;

function extract:xy;
var     p,c:longint;
        v:xy;
begin
        result:=h[1];
        v:=h[nh];
        dec(nh);
        p:=1;
        repeat
                c:=2*p;
                if (c<nh) and (d[h[c+1].x,h[c+1].y]<d[h[c].x,h[c].y]) then inc(c);
                if (c>nh) or (d[h[c].x,h[c].y]>=d[v.x,v.y]) then break;
                h[p]:=h[c];
                pos[h[p].x,h[p].y]:=p;
                p:=c;
        until false;
        h[p]:=v;
        pos[v.x,v.y]:=p;
end;

procedure dijkstra;
var     i,j:longint;
        v:e;
        u:xy;
begin
        for i:=1 to n do for j:=0 to k do d[i,j]:=oo;
        d[1,0]:=0;
        update(1,0);
        repeat
                u:=extract;
                i:=head[u.x];
                while i>0 do
                begin
                        v:=adj[i];
                        if d[v.v,u.y]>d[u.x,u.y]+v.w then
                        begin
                                d[v.v,u.y]:=d[u.x,u.y]+v.w;
                                update(v.v,u.y);
                        end;
                        if u.y<k then
                        if d[v.v,u.y+1]>d[u.x,u.y] then
                        begin
                                d[v.v,u.y+1]:=d[u.x,u.y];
                                update(v.v,u.y+1);
                        end;
                        i:=v.link;
                end;
        until nh=0;
end;

procedure output;
var     i,res:longint;
begin
        res:=oo;
        for i:=1 to k do
        res:=min(res,d[n,i]);
        write(res);
end;

begin
        input;
        dijkstra;
        output;
end.

Download