Cod sursa(job #407236)

Utilizator hungntnktpHungntnktp hungntnktp Data 2 martie 2010 10:19:53
Problema Algoritmul lui Dijkstra Scor 50
Compilator fpc Status done
Runda Arhiva educationala Marime 2.25 kb
{DINH QUANG DAT TIN 07-10}
{DIJKSTRA}
{$inline on}
{$mode objfpc}
CONST
 TFI='dijkstra.in';
 TFO='dijkstra.out';
 MAX=50001;
 maxval=1000000000;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v,c:longint;
         next:pnode;
        end;
 xyz=record
      x,y,z:longint;
     end;
VAR
 fi,fo:text;
 nheap,m,n:longint;
 st,res,d,heap,pos:arr1int;
 a,ke:array[0..250001] of longint;
 list:array[0..250001] of xyz;

PROCEDURE       input;inline;
var
 u,v,c,i:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,n,m);
  st[1]:=1;
  for i:= 1 to m do
   with list[i] do
   begin
    read(fi,x,y,z);
    inc(st[x]);
   end;
  for i:= 1 to n do st[i]:=st[i-1]+st[i];
  for i:= 1 to m do
   with list[i] do
    begin
     dec(st[x]);
     ke[st[x]]:=y;
     a[st[x]]:=z;
    end;
 close(fi);
end;

PROCEDURE       init;inline;
var
 i:longint;
begin
 nheap:=0;
 fillchar(pos,sizeof(pos),0);
 for i:= 1 to n do d[i]:=maxval;
 d[1]:=0;
end;

PROCEDURE       update(u:longint);inline;
var
 child,parent:longint;
begin
 child:=pos[u];
 if child = 0 then
  begin
   inc(nheap);
   child:=nheap;
  end;
 parent:= child div 2;
 while (parent>0) and (d[heap[parent]]>d[u]) do
  begin
   heap[child]:=heap[parent];
   pos[heap[child]]:=child;
   child:=parent;
   parent:= child div 2;
  end;
 pos[u]:=child;
 heap[child]:=u;
end;

FUNCTION        pop:longint;inline;
var
 r,v,c:longint;
begin
 pop:=heap[1];
 v:=heap[nheap];
 dec(nheap);
 r:=1;
 while r*2<=nheap do
  begin
   c:=r*2;
   if (c<nheap) and (d[heap[c]]>d[heap[c+1]]) then inc(c);
   if d[heap[c]]>=d[v] then break;
   heap[r]:=heap[c];
   pos[heap[r]]:=r;
   r:=c;
  end;
 pos[v]:=r;
 heap[r]:=v;
end;

PROCEDURE       process;inline;
var
 u,v,i:longint;
begin
 update(1);
 repeat
  u:=pop;
  for v:= st[u] to st[u+1]-1 do
   if d[ke[v]]>d[u]+a[v] then
    begin
     d[ke[v]]:=d[u]+a[v];
     update(ke[v]);
    end;
 until nheap = 0;
 for i:= 2 to n do
  if d[i]=maxval then res[i]:=0 else res[i]:=d[i];
end;

PROCEDURE       output;
var
 i:longint;
begin
 assign(fo,tfo);rewrite(fo);
  for i:= 2 to n do write(fo,res[i],' ');
 close(fo);
end;

BEGIN
 input;
 init;
 process;
 output;
END.