Cod sursa(job #581606)

Utilizator muskMuscalu Alexandru musk Data 14 aprilie 2011 13:17:37
Problema Algoritmul Bellman-Ford Scor 35
Compilator fpc Status done
Runda Arhiva educationala Marime 1.05 kb
var e:array[1..3,1..5000] of longint;
    n,m,i,j,k,c:integer;
    f,g:text;
    d,t:array[1..5000]of longint;

procedure citire;
var i,j,k,c:integer;
begin
assign(f,'bellmanford.in');reset(f);
read(f,n,m);
for k:=1 to m do
    read(f,e[1,k],e[2,k],e[3,k]);
close(f);
end;

procedure bellman;
var nr:integer;
    ok:boolean;
begin
for i:=1 to n do d[i]:=maxint;
d[1]:=0;
ok:=true;
nr:=1;
while ok and(nr<n) do
 begin
 ok:=false;
 for k:=1 to m do
     begin
     i:=e[1,k];
     j:=e[2,k];
     c:=e[3,k];
     if d[j]>d[i]+c then
         begin
         d[j]:=d[i]+c;
         ok:=true;
         t[j]:=i;
         end;
     end;
 nr:=nr+1;
 end;

assign(g,'bellmanford.out');rewrite(g);
ok:=false;
k:=1;
while not ok and (k<=m)do
   begin
   i:=e[1,k];
   j:=e[2,k];
   c:=e[3,k];
   if d[j]>d[i]+c then begin write(g,'Ciclu negativ!');   ok:=true; end;
   k:=k+1
   end;
if not ok then
 for i:=2 to n do  write(g,d[i],' ');
close(g);
 end;

begin
citire;
bellman;
end.