Cod sursa(job #407291)

Utilizator hungntnktpHungntnktp hungntnktp Data 2 martie 2010 10:55:57
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 3.38 kb
{$M 64000000,0}
{$H-,I-,Q-,R-,S-}
{La hoang
Ngay 2-3-2010
Dijkstra Heap}
const
   TFI  = 'dijkstra.in';
   TFO  = 'dijkstra.out';
   MaxN = 50000;
   MaxM = 250000;
   oo = 1000 * MaxN + 1;
var
   n, m, nHeap: longint;
   A, Link, C: array[1..MaxM] of longint;
   Vt, H, Vh: array[1..MaxN] of longint;
   D: array[1..MaxN] of longint;
   Free: array[1..MaxN] of boolean;
   (*-----------------------------------*)
   procedure Input;
   var
      fi: text;
      i, u, v: longint;
   begin
      Assign(fi, TFI); Reset(fi);
      Fillchar(Vt, sizeof(Vt), 0);
      Readln(fi, n, m);
      for i := 1 to m do
         begin
            Readln(fi, u, v, C[i]);
            A[i] := v;
            Link[i] := Vt[u];
            Vt[u] := i;
         end;
      Close(fi);
   end;
   (*-----------------------------------*)
   procedure Init;
   var
      i: longint;
   begin
      Fillchar(Vh, sizeof(Vh), 0);
      Fillchar(Free, sizeof(Free), true);
      D[1] := 0;
      nHeap := 0;
      for i := 2 to n do D[i] := oo;
   end;
   (*-----------------------------------*)
   procedure Up(node: longint);
   var
      x, root: longint;
   begin
      x := H[node];
      Repeat
         root := node div 2;
         if (root = 0) or (D[H[root]] < D[x]) then break;
         H[node] := H[root];
         Vh[H[node]] := node;
         node := root;
      until false;
      H[node] := x;
      Vh[x] := node;
   end;
   (*-----------------------------------*)
   procedure Down(node: longint);
   var
      x, child: longint;
   begin
      x := H[node];
      Repeat
         child := node * 2;
         if (child < nHeap) and (D[H[child]] > D[H[child + 1]]) then inc(child);
         if (child > nHeap) or (D[H[child]] > D[x]) then break;
         H[node] := H[child];
         Vh[H[node]] := node;
         node := child;
      until false;
      H[node] := x;
      Vh[x] := node;
   end;
   (*-----------------------------------*)
   procedure Push(u: longint);
   begin
      if Vh[u] = 0 then
         begin
            inc(nHeap);
            H[nHeap] := u;
            Vh[u] := nHeap;
         end;
      Up(Vh[u]);
   end;
   (*-----------------------------------*)
   function Pop: longint;
   begin
      Pop := H[1];
      Vh[H[1]] := 0;
      H[1] := H[nHeap];
      Vh[H[1]] := 1;
      dec(nHeap);
      if nHeap > 1 then Down(1);
   end;
   (*-----------------------------------*)
   procedure Process;
   var
      i, u, v, j: longint;
   begin
      Push(1);
      for i := 2 to n do
         if nHeap > 0 then
         begin
            u := Pop;
            Free[u] := false;
            j := Vt[u];
            While j <> 0 do
               begin
                  v := A[j];
                  if Free[v] and (D[v] > D[u] + C[j]) then
                     begin
                        D[v] := D[u] + C[j];
                        Push(v);
                     end;
                  j := Link[j];
               end;
         end;
   end;
   (*-----------------------------------*)
   procedure Output;
   var
      fo:text;
      i: longint;
   begin
      Assign(fo, TFO); Rewrite(fo);
      for i := 2 to n do
         if D[i] = oo then Write(fo, 0, ' ') else WRite(fo, D[i], ' ');
      Close(fo);
   end;
   (*-----------------------------------*)
begin
   Input;
   Init;
   Process;
   Output;
end.