REVAMP - Revamping Trails

Tác giả: flashmt

Ngôn ngữ: Pascal

const maxm=50100;
      maxn=10100;
var n,m,k,nh:longint;
    pos,sl,cur:array[1..maxn] of longint;
    a,v:array[1..maxm*2] of longint;
    b,c,e:array[1..maxm] of longint;
    d:array[0..20,1..maxn] of boolean;
    p:array[0..20,1..maxn] of longint; 
    f:array[0..20,1..maxn] of int64;
    h,g:array[1..22*maxn] of longint;
    oo:int64;

procedure rf;
var i,j:longint;
begin
     read(n,m,k);
     for i:=1 to m do
     begin
          read(b[i],c[i],e[i]);
          inc(sl[b[i]]);
          inc(sl[c[i]]);
     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]]]:=c[i];
          v[cur[b[i]]]:=e[i];
          inc(cur[b[i]]);
          a[cur[c[i]]]:=b[i];
          v[cur[c[i]]]:=e[i];
          inc(cur[c[i]]);
     end;
end;

procedure init;
var i,j:longint;
begin
     oo:=1000000000;
     oo:=oo*oo;
     for i:=0 to k do
       for j:=1 to n do
         f[i,j]:=oo;
     nh:=0;
end;

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

procedure pop(var xx,yy:longint);
var x,y,cha,con:longint;
begin
     xx:=g[1]; yy:=h[1];
     x:=g[nh]; y:=h[nh];
     nh:=nh-1;
     cha:=1; con:=2;
     while con<=nh do
     begin
          if (con<nh) and (f[g[con+1],h[con+1]]<f[g[con],h[con]]) then con:=con+1;
          if f[x,y]<=f[g[con],h[con]] then break;
          h[cha]:=h[con];
          g[cha]:=g[con];
          p[g[cha],h[cha]]:=cha;
          cha:=con;
          con:=cha shl 1;
     end;
     h[cha]:=y; g[cha]:=x;
     p[x,y]:=cha;
end;

procedure pr;
var i,j,x,y:longint; 
begin
     f[k,1]:=0;
     for i:=0 to k-1 do d[i,1]:=true;
     update(k,1);
     repeat
           pop(x,y);
           d[x,y]:=true;
           if y=n then
           begin
                writeln(f[x,y]);
                exit;
           end;
           for i:=0 to x do
             for j:=pos[y] to pos[y+1]-1 do
               if not d[i,a[j]] and (f[i,a[j]]>f[x,y]+v[j]*ord(x=i)) then
               begin
                    f[i,a[j]]:=f[x,y]+v[j]*ord(x=i);
                    update(i,a[j]);
               end;
     until false;
end;

begin
     rf;
     init;
     pr;
end.

Download