Cod sursa(job #408488)

Utilizator hungntnktpHungntnktp hungntnktp Data 3 martie 2010 04:45:49
Problema Algoritmul Bellman-Ford Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.68 kb
{DINH QUANG DAT TIN 07-10}
{DIJKSTRA}
CONST
 TFI='bellmanford.in';
 TFO='bellmanford.out';
 MAX=50001;
 maxq=MAX;
 maxval=1000000000;
TYPE
 arr1int=array[0..MAX] of longint;
 pnode = ^node;
 node = record
         v,c:longint;
         next:pnode;
        end;
VAR
 fi,fo:text;
 first,last,nheap,m,n:longint;
 ke:array[0..MAX] of pnode;
 queue,res,d,pos:arr1int;

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);
 for i:= 1 to n do d[i]:=maxval;
 d[1]:=0;
end;


PROCEDURE       update(u:longint);
begin
 if not free[u] then exit;
 last:=last+1;
 if last=maxq then last:=1;
 queue[last]:=u;
 free[u]:=false;
end;

FUNCTION        pop:longint;
begin
 first:=first+1;
 if first=maxq then first:=1;
 pop:=queue[first];
 free[pop]:=true;
end;

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