ROADS - Roads

Tác giả: ll931110

Ngôn ngữ: Pascal

{$MODE DELPHI}
Program ROADS;
Const
  input  = '';
  output = '';
  maxn = 101;
  maxk = 10000;
Type
  rec = record
    kx,ky: integer;
  end;
Var
  h: array[1..maxn + 1] of integer;
  adj,adjlen,adjcost: array[1..maxk] of integer;
  x,y,c,l: array[1..maxk] of integer;
  pos,d: array[1..maxn,0..maxk] of integer;
  heap: array[1..maxn * maxk] of rec;
  fi,fo: text;
  free: array[1..maxn,0..maxk] of boolean;
  k,r,n,t,i,nHeap: integer;

Procedure openfile;
Begin
  Assign(fi, input);
    Reset(fi);

  Assign(fo, output);
    Rewrite(fo);
End;

Procedure init;
Var
  i: integer;
Begin
  Read(fi, k, n, r);
  Fillchar(h, sizeof(h), 0);

  For i:= 1 to r do
    Begin
      Readln(fi, x[i], y[i], l[i], c[i]);
      inc(h[x[i]]);
    End;

  For i:= 2 to n do h[i]:= h[i] + h[i - 1];
  For i:= 1 to r do
    Begin
      adj[h[x[i]]]:= y[i];
      adjlen[h[x[i]]]:= l[i];
      adjcost[h[x[i]]]:= c[i];
      dec(h[x[i]]);
    End;

  h[n + 1]:= r;
End;

Function low(u,v: rec): boolean;
Begin
  low:= d[u.kx,u.ky] < d[v.kx,v.ky];
End;

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

  parent:= child div 2;
  While (parent > 0) and low(v,heap[parent]) do
    Begin
      heap[child]:= heap[parent];
      pos[heap[child].kx,heap[child].ky]:= child;

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

  heap[child]:= v;
  pos[v.kx,v.ky]:= child;
End;

Function pop: rec;
Var
  re,rc: integer;
  v: rec;
Begin
  pop:= heap[1];
  v:= heap[nHeap];
  dec(nHeap);

  re:= 1;
  While (re * 2 <= nHeap) do
    Begin
      rc:= re * 2;
      If (rc < nHeap) and low(heap[rc + 1],heap[rc]) then inc(rc);
      If not low(heap[rc],v) then break;

      heap[re]:= heap[rc];
      pos[heap[re].kx,heap[re].ky]:= re;
      re:= rc;
    End;

  heap[re]:= v;
  pos[v.kx,v.ky]:= re;
End;

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

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

  u.kx:= 1;
  u.ky:= k;
  update(u);

  Repeat
    u:= pop;
    free[u.kx,u.ky]:= false;

    For iv:= h[u.kx] + 1 to h[u.kx + 1] do
      Begin
        s.kx:= adj[iv];
        s.ky:= u.ky - adjcost[iv];

        If (s.ky >= 0) and free[s.kx,s.ky]
          and (d[s.kx,s.ky] > d[u.kx,u.ky] + adjlen[iv]) then
            Begin
              d[s.kx,s.ky]:= d[u.kx,u.ky] + adjlen[iv];
              update(s);
            End;
      End;
  Until nHeap = 0;
End;

Procedure printresult;
Var
  i: integer;
  min: integer;
Begin
  min:= maxn * maxk;
  For i:= k downto 0 do
    if min > d[n,i] then min:= d[n,i];

  If min = maxn * maxk then writeln(fo, -1) else writeln(fo, min);
End;

Procedure closefile;
Begin
  Close(fo);
  Close(fi);
End;

Begin
  openfile;

  Readln(fi, t);
  For i:= 1 to t do
    Begin
      init;
      Dijkstra;
      printresult;
    End;

  closefile;
End.

Download