Cod sursa(job #404297)

Utilizator nickyyLal Daniel Emanuel nickyy Data 26 februarie 2010 00:14:49
Problema Algoritmul Bellman-Ford Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.77 kb
const infile='bellmanford.in';
  outfile='bellmanford.out';
  maxn=50003;
  infinit=1000000000;
type nod=^pnod;
  pnod=record  vf:longint; urm:nod; end;
  coada=record  prim,ultim:nod; end;
  list=^vec;
  vec=record  inf,cost:longint; next:list; end;
var a:array[1..maxn]of list;
  inq,d:array[1..maxn]of longint;
  q:coada;
  n,m:longint;

 procedure citire;
 var i,j,c:longint;
   p:list;
 begin
   assign(input,infile); reset(input); readln(n,m);
   while(m>0)do begin
     readln(i,j,c); dec(m);
     new(p); p^.inf:=j; p^.cost:=c; p^.next:=a[i]; a[i]:=p;
     end;
   close(input);
 end;

 procedure pop;
 var r:nod;
 begin
   with q do begin
     r:=prim; prim:=prim^.urm;
     dispose(r);
     end;
 end;

 procedure push(x:longint);
 var r:nod;
 begin
   with q do
     if(prim=nil)then begin
       new(prim); prim^.vf:=x;
       prim^.urm:=nil; ultim:=prim
       end
     else begin
       new(r); r^.vf:=x; r^.urm:=nil;
       ultim^.urm:=r; ultim:=r;
       end;
 end;

 function BellmanFord:boolean;
 var p:list;
   x,i:longint;
   ok:boolean;
 begin
   for i:=2 to n do d[i]:=infinit;
   ok:=true;
   push(1);
   d[1]:=0; inq[1]:=1;
   while(q.prim<>nil)and(ok)do begin
     x:=q.prim^.vf;
     pop;
     p:=a[x];
     while(p<>nil)do begin
       if(d[p^.inf]>d[x]+p^.cost)then begin
         d[p^.inf]:=d[x]+p^.cost; push(p^.inf);
         inc(inq[p^.inf]);
         end;
       if(inq[p^.inf]>=n)then ok:=false;
       p:=p^.next;
       end;
     end;
   BellmanFord:=ok;
 end;

 procedure afisare;
 var i:longint;
 begin
   assign(output,outfile); rewrite(output);
   if BellmanFord then for i:=2 to n do write(d[i],' ')
   else write('Ciclu negativ!');
   close(output);
 end;

Begin
  citire; afisare;
End.