Dijkstra 二叉堆实现 Pascal

{单源最短路径的Dijkstra算法。使用二叉堆挑选总复杂度O((e+v)logv)}
 const
   maxn=100;
 type
   link=^node;      //邻接表类型
    node=record
         v,w    :integer;
         next   :link;
       end;
  htype=record          //堆节点
          v,d,p :integer;
        end;
 var
   n,s,hl        :integer;     //顶点数；源点；堆长度
   heap          :array[0..maxn]of htype;
   hpos          :array[1..maxn]of integer;   //hpos[v]:顶点v在堆中的位置
   g             :array[1..maxn]of link;    //邻接表
 procedure insert(u,v,w:integer);      //将权值为w的边(u,v)插入到邻接表
 var
   x     :link;
 begin
   new(x);
   x^.v:=v; x^.w:=w;
   x^.next:=g[u]; g[u]:=x;
 end;
 procedure init;        //初始化
 var
   u,v,w :integer;
 begin
   assign(input,'g.in');reset(input);
   readln(n,s);
   while not eof do
     begin
       readln(u,v,w);
       insert(u,v,w);insert(v,u,w);
     end;
 end;
 procedure swap(a,b:integer);           //交换堆中下标为a,b的节点
 begin
   heap[0]:=heap[a];heap[a]:=heap[b];heap[b]:=heap[0];
   hpos[heap[a].v]:=a;hpos[heap[b].v]:=b;
 end;
 procedure decrease(i:integer);         //减小键值并恢复堆性质
 begin
   while (i<>1)and(heap[i].d<heap[i div 2].d) do
     begin
       swap(i,i div 2);
       i:=i div 2;
     end;
 end;
 procedure heapify;        //恢复堆性质
 var
   i     :integer;
 begin
   i:=2;
   while i<=hl do
     begin
       if(i<hl)and(heap[i+1].d<heap[i].d) then inc(i);
       if heap[i].d<heap[i div 2].d then
         begin
           swap(i,i div 2);
           i:=i*2;
         end
       else break
     end;
 end;
 procedure relax(u,v,w:integer);       //松弛操作
 begin
   if w+heap[hpos[u]].d<heap[hpos[v]].d then
     begin
       heap[hpos[v]].p:=u;
       heap[hpos[v]].d:=w+heap[hpos[u]].d;
       decrease(hpos[v]);
     end;
 end;
 procedure dijkstra;          //主过程
 var
   u     :integer;
   p     :link;
 begin
   for u:=1 to n do         //初始化堆
     begin
       heap[u].v:=u;
       heap[u].d:=maxint;
       hpos[u]:=u;
     end;
   heap[s].p:=s;heap[s].d:=0;swap(1,s);
   hl:=n;
   while hl>0 do
    begin
      u:=heap[1].v;
      swap(1,hl);dec(hl);heapify;     //将堆的根节点移出堆并恢复堆性质
      p:=g[u];
      while p<>nil do
        begin
          if hpos[p^.v]<=hl then relax(u,p^.v,p^.w);   //对与u邻接且在堆中的顶点进行松弛操作
          p:=p^.next;
        end;
    end;
 end;
 procedure path(i:integer);
 begin
  if heap[hpos[i]].p<>s then path(heap[hpos[i]].p);
  write('-->',i);
 end;
 procedure show;
 var
  i     :integer;
 begin
  for i:=1 to n do
    begin
      write(i:3,':',heap[hpos[i]].d:3,':',s);
      path(i);        //递归输出路径
      writeln;
    end
 end;
 {==========main===========}
 begin
 init;
 dijkstra;
 show;
 end.