Cod sursa(job #575024)

Utilizator andrei31Andrei Datcu andrei31 Data 7 aprilie 2011 19:59:04
Problema Algoritmul Bellman-Ford Scor 35
Compilator fpc Status done
Runda Arhiva educationala Marime 1.36 kb

const nmax=50000;
      inf=10000*nmax+1;
type  muchie=record
             x,y:word;
             c:integer;
             end;
      ref=^nod;
      nod=record
          vf:word;
          c:integer;
          urm:ref;
          end;


var use:array[1..nmax] of word;
    q:Array[1..200000] of word;
    d:array[1..nmax] of longint;
    ciclu:boolean;
    g:array[1..nmax] of ref;
    n:word;
    m:longword;

procedure adaugare(x,y:word;c:integer);
var p:Ref;
begin
new(p);
p^.vf:=y;p^.c:=c;
p^.urm:=g[x];
g[x]:=p;
end;

procedure citire;
var i:longword;
    x,y:word;
    c:integer;
begin
assign(input,'bellmanford.in');reset(input);
readln(n,m);
for i:=1 to m do
 begin
 readln(x,y,c);
 adaugare(x,y,c);
 end;
close(input);
end;

procedure bellman;
var  p,u:word;
     k:ref;
begin
for p:=2 to n do
d[p]:=inf;
p:=1;u:=1;q[1]:=1;d[1]:=0;
while (p<=u) and not ciclu do
 begin
 k:=g[q[p]];
  while k<>nil do
   begin
   if d[k^.vf]>d[q[p]]+k^.c then
    begin
    d[k^.vf]:=d[q[p]]+k^.c;
    inc(use[k^.vf]);
    inc(u);
    q[u]:=k^.vf;
    if use[k^.vf]>n then ciclu:=true;
     end;
    k:=k^.urm;
    end;
  inc(p);
 end;
assign(output,'bellmanford.out');rewrite(output);
if ciclu then writeln('Ciclu negativ!')
 else
  for p:=2 to n do write(d[p],' ');
 close(output);
end;


begin
citire;
bellman;
end.