Cod sursa(job #407226)

Utilizator hungntnktpHungntnktp hungntnktp Data 2 martie 2010 10:15:13
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 2.2 kb
{DINH QUANG DAT TIN 07-10}
{DIJKSTRA}
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;
VAR
 fi,fo:text;
 nheap,m,n:longint;
 ke:array[0..MAX] of pnode;
 res,d,heap,pos:arr1int;
 free:array[0..MAX] of boolean;

PROCEDURE       add(u,v,c:longint);
var
 t:pnode;
begin
 new(t);
 t^.v:=v;
 t^.c:=c;
 t^.next:=ke[u];
 ke[u]:=t;
end;

PROCEDURE       input;
var
 u,v,c,i:longint;
begin
 assign(fi,tfi);reset(fi);
  read(fi,n,m);
  for i:= 1 to m do
   begin
    read(fi,u,v,c);
    add(u,v,c);
   end;
 close(fi);
end;

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

PROCEDURE       update(u:longint);
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;
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;
var
 t:pnode;
 u,v,i:longint;
begin
 update(1);
 repeat
  u:=pop;
  t:=ke[u];
  free[u]:=false;
  while t<>nil do
   begin
    v:=t^.v;
    if (d[v]>d[u]+t^.c) and (free[v]) then
     begin
      d[v]:=d[u]+t^.c;
      update(v);
     end;
    t:=t^.next;
   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.