Cod sursa(job #1359102)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 24 februarie 2015 21:17:11
Problema Algoritmul Bellman-Ford Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 1.2 kb
program mire;
var a:array[1..4000,1..4000] of integer;
   d:array[1..5000] of longint ;
   f,g:text;
   n,m:integer;
procedure citire;
var i,x,y,c,j:integer;
  begin
   assign(f,'bellmanford.in'); reset(f);
     readln(f,n,m);
     for i:=1 to m do
       begin
         readln(f,x,y,c);
         a[x,y]:=c;
       end;
     for i:=1 to n do
     begin
       for j:=1 to n do
         if (i<>j) and (a[i,j]=0) then
           a[i,j]:=maxint;
       d[i]:=maxint;
     end;
   close(f);
  end;
function bellmanford:boolean;
var i,j,k:integer;
  ok:boolean;
begin
  d[1]:=0;
   for k:=1 to n do
     begin
       ok:=false;
       for i:=1 to n do
         for j:=1 to n do
             if (d[i]<>maxint)  and (a[i,j]<>maxint)  then
              if d[j]>d[i]+a[i,j] then
                begin
                   d[j]:=d[i]+a[i,j];
                   ok:=true;
                end;
     end;
     bellmanford:=ok;
end;
procedure afis;
var i:integer;
begin
assign(g,'bellmanford.out'); rewrite(g);
 if bellmanford then
   writeln(g,'Ciclu negativ!')
  else
    begin
      for i:=2 to n do
        write(g,d[i],' ');
    end;
    close(g);
end;
begin
 citire;
 afis;
end.