Cod sursa(job #698629)

Utilizator doruletzPetrican Teodor doruletz Data 29 februarie 2012 15:20:49
Problema Algoritmul Bellman-Ford Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.04 kb
type pointer=^nod;
     nod=record
        x,y,cost:integer;
        urm:pointer;
     end;

var prim,ult,c:pointer;
    n,m,x,y,z,i,j:longint;
    d:array[0..50001]of longint;
    f:text;
    ok:boolean;
    
procedure adauga(x,y,z:longint);
begin
 new(c);
 c^.x:=x;
 c^.y:=y;
 c^.cost:=z;
 c^.urm:=nil;
 ult^.urm:=c;
 ult:=c;
end;

procedure parcurge;
begin
 c:=prim;
 while c<>nil do begin
  if d[c^.x]+c^.cost<d[c^.y] then d[c^.y]:=c^.cost+d[c^.x];
  c:=c^.urm;
 end;
end;

begin
 assign(f,'bellmanford.in'); reset(f);
 readln(f,n,m);
 readln(f,x,y,z);
 new(prim);
 prim^.x:=x;
 prim^.y:=y;
 prim^.cost:=z;
 prim^.urm:=nil;
 ult:=prim;
 for i:=2 to m do begin
  readln(f,x,y,z);
  adauga(x,y,z);
 end;
 close(f);
 
 for i:=1 to n do d[i]:=maxlongint;
 d[1]:=0;
 
 for i:=1 to n-1 do parcurge;
 
 c:=prim;
 ok:=false;
 while (c<>nil)and(ok=false) do begin
  if d[c^.x]+c^.cost<d[c^.y] then ok:=true;
  c:=c^.urm;
 end;
 
 assign(f,'bellmanford.out'); rewrite(f);
 if ok=true then writeln('Ciclu negativ!') else
  for i:=2 to n do write(d[i],' ');
 close(f);
end.