REVAMP - Revamping Trails

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
Program REVAMP;
Const
  input  = '';
  output = '';
  maxn = 10000;
  maxm = 50000;
  maxk = 20;
  maxc = 1000000000;
Type
  rec = record
    x,y: integer;
  end;
Var
  n,m,k: integer;
  u,modi: integer;
  nHeap: integer;
  p,q,c: array[1..maxm] of integer;
  heap: array[1..300000] of rec;
  adj,adjcost: array[1..2 * maxm] of integer;
  h: array[1..maxn + 1] of integer;
  d,pos: array[1..maxn,0..maxk] of integer;
  free: array[1..maxn,0..maxk] of boolean;

Procedure init;
Var
  f: text;
  i: integer;
Begin
  Fillchar(h, sizeof(h), 0);

  Assign(f, input);
    Reset(f);

  Readln(f, n, m, k);
  For i:= 1 to m do
    Begin
      Readln(f, p[i], q[i], c[i]);
      inc(h[p[i]]);
      inc(h[q[i]]);
    End;

  Close(f);

  For i:= 2 to n do h[i]:= h[i] + h[i - 1];
  For i:= 1 to m do
    Begin
      adj[h[p[i]]]:= q[i];
      adjcost[h[p[i]]]:= c[i];
      dec(h[p[i]]);

      adj[h[q[i]]]:= p[i];
      adjcost[h[q[i]]]:= c[i];
      dec(h[q[i]]);
    End;

  h[n + 1]:= 2 * m;
End;

Procedure update(u,v: integer);
Var
  parent,child: integer;
Begin
  child:= pos[u,v];
  If child = 0 then
    Begin
      inc(nHeap);
      child:= nHeap;
    End;

  parent:= child div 2;
  While (parent > 0) and (d[heap[parent].x,heap[parent].y] > d[u,v]) do
    Begin
      heap[child]:= heap[parent];
      pos[heap[child].x,heap[child].y]:= child;

      child:= parent;
      parent:= child div 2;
    End;

  heap[child].x:= u;
  heap[child].y:= v;
  pos[u,v]:= child;
End;

Procedure pop;
Var
  r,s,popx,popy: integer;
Begin
  u:= heap[1].x;
  modi:= heap[1].y;

  popx:= heap[nHeap].x;
  popy:= heap[nHeap].y;
  dec(nHeap);

  r:= 1;
  While r * 2 <= nHeap do
    Begin
      s:= r * 2;
      If (s < nHeap) and (d[heap[s + 1].x,heap[s + 1].y] < d[heap[s].x,heap[s].y]) then inc(s);
      If d[popx,popy] <= d[heap[s].x,heap[s].y] then break;

      heap[r]:= heap[s];
      pos[heap[r].x,heap[r].y]:= r;
      r:= s;
    End;

  heap[r].x:= popx;
  heap[r].y:= popy;
  pos[popx,popy]:= r;
End;

Procedure Dijkstra;
Var
  i,j,v,iv: integer;
Begin
  Fillchar(pos, sizeof(pos), 0);
  nHeap:= 0;

  Fillchar(free, sizeof(free), true);

  For i:= 1 to n do
    For j:= 0 to k do d[i,j]:= maxc;

  d[1,0]:= 0;
  update(1,0);

  Repeat
    pop;
    free[u,modi]:= false;

    For iv:= h[u] + 1 to h[u + 1] do
      Begin
        v:= adj[iv];
        If free[v,modi] and (d[v,modi] > d[u,modi] + adjcost[iv]) then
          Begin
            d[v,modi]:= d[u,modi] + adjcost[iv];
            update(v,modi);
          End;

        If modi < k then
          If free[v,modi + 1] and (d[v,modi + 1] > d[u,modi]) then
            Begin
              d[v,modi + 1]:= d[u,modi];
              update(v,modi + 1);
            End;
      End;
  Until nHeap = 0;
End;

Procedure printresult;
Var
  f: text;
Begin
  Assign(f, output);
    Rewrite(f);
    Writeln(f, d[n,k]);
  Close(f);
End;

Begin
  init;
  Dijkstra;
  printresult;
End.

Download