REVAMP - Revamping Trails

Tác giả: RR

Ngôn ngữ: Pascal

{
ID: invinci3
PROG: revamp
LANG: PASCAL
}
{$R+,Q+}
uses math;
const
  FINP='';
  FOUT='';
  MAXN=10001;
  oo=1000000001;
type
  list=^node;
  node=record
         u,c:longint;
         next:list;
       end;
var
  f1,f2:text;
  k,hsize,n:longint;
  ke:array[1..MAXN] of list;
  hpos,d:array[1..MAXN,0..20] of longint;
  hu,hv:array[1..MAXN*20] of longint;
procedure openF;
begin
  assign(f1,FINP); reset(f1);
  assign(f2,FOUT); rewrite(f2);
end;
procedure closeF;
begin
  close(f1); close(f2);
end;
procedure add(u,c:longint; var a:list); inline;
var
  p:list;
begin
  new(p); p^.u:=u; p^.c:=c;
  p^.next:=a; a:=p;
end;
procedure inp;
var
  i,u,v,c,m:longint;
begin
  read(f1,n,m,k);
  for i:=1 to m do
    begin
      read(f1,u,v,c);
      add(u,c,ke[v]);
      add(v,c,ke[u]);
    end;
end;
procedure swap(var a,b:longint); inline;
var
  temp:longint;
begin
  temp:=a; a:=b; b:=temp;
end;
procedure downHeap(i:longint);
var
  j:longint;
begin
  j:=i<<1;
  while (j<=hsize) do
    begin
      if (j<hsize) and (d[hu[j+1],hv[j+1]]<d[hu[j],hv[j]]) then inc(j);
      if (d[hu[i],hv[i]]>d[hu[j],hv[j]]) then
        begin
          swap(hpos[hu[i],hv[i]],hpos[hu[j],hv[j]]);
          swap(hu[i],hu[j]);
          swap(hv[i],hv[j]);
        end;
      i:=j; j:=i<<1;
    end;
end;
procedure upHeap(i:longint);
var
  j:longint;
begin
  j:=i>>1;
  while (i>1) and (d[hu[i],hv[i]]<d[hu[j],hv[j]]) do
    begin
      swap(hpos[hu[i],hv[i]],hpos[hu[j],hv[j]]);
      swap(hu[i],hu[j]);
      swap(hv[i],hv[j]);
      i:=j; j:=i>>1;
    end;
end;
procedure push(u,v:longint);
begin
  inc(hsize); hu[hsize]:=u; hv[hsize]:=v; hpos[u,v]:=hsize;
  upHeap(hsize);
end;
procedure pop(var u,v:longint);
begin
  u:=hu[1]; v:=hv[1]; hpos[u,v]:=0;
  swap(hu[1],hu[hsize]); swap(hv[1],hv[hsize]); hpos[hu[1],hv[1]]:=1;
  dec(hsize); downHeap(1);
end;
procedure solve;
var
  u,v,c,uu,vv:longint;
  p:list;
begin
  hsize:=0;
  for u:=1 to n do for v:=0 to k do d[u,v]:=oo;
  d[1,0]:=0;
  push(1,0);
  while hsize>0 do
    begin
      pop(u,v);
      if u=n then
        begin
          writeln(f2,d[u,v]);
          exit;
        end;
      p:=ke[u];
      while p<>nil do
        begin
          uu:=p^.u; c:=p^.c; p:=p^.next;
          //Thay canh (u,v) = 0
          if v<k then
              if d[uu,v+1]>d[u,v] then
                begin
                  d[uu,v+1]:=d[u,v];
                  if hpos[uu,v+1]=0 then push(uu,v+1)
                  else upHeap(hpos[uu,v+1]);
                end;
          //Di qua canh (u,v)
          if d[uu,v]>d[u,v]+c then
            begin
              d[uu,v]:=d[u,v]+c;
              if hpos[uu,v]=0 then push(uu,v)
              else upHeap(hpos[uu,v]);
            end;
        end;
    end;
end;
begin
  openF;
  inp;
  solve;
  closeF;
end.

Download