Cod sursa(job #698893)

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

var prim,ult:array[0..50001]of pointer;
    d,v:array[0..250001]of integer;
    i,j,n,m,x,y,cost:integer;
    ok:boolean;
    f:text;

procedure adauga(x,y,cost:integer);
var c:pointer;
begin
 if prim[x]=nil then begin 
  new(prim[x]);
  prim[x]^.y:=y;
  prim[x]^.cost:=cost;
  prim[x]^.urm:=nil;
  ult[x]:=prim[x];
 end else begin
  new(c);
  c^.y:=y;
  c^.cost:=cost;
  c^.urm:=nil;
  ult[x]^.urm:=c;
  ult[x]:=c;
 end;
end;

procedure dfs;
var c,cc:pointer;
begin
 cc:=prim[0];
 ok:=true;
 while (cc<>nil)and(ok=true) do begin
  c:=prim[cc^.y];
  inc(v[cc^.y]);
  if v[cc^.y]>n then begin
    writeln(f,'Ciclu negativ!');
    ok:=false;
  end;
  while c<> nil do begin
   if d[cc^.y]+c^.cost<d[c^.y] then begin
    d[c^.y]:=d[cc^.y]+c^.cost;
    adauga(0,c^.y,0);
   end;
   c:=c^.urm;
  end;
  cc:=cc^.urm;
 end;
end;
 

begin
 assign(f,'bellmanford.in');
 readln(f,n,m);
 for i:=1 to m do begin
  readln(f,x,y,cost);
  adauga(x,y,cost);
 end;
 close(f);
 
 adauga(0,1,0);
 
 for i:=2 to n do d[i]:=maxint;
 assign(f,'bellmanford.out');
 dfs;
 if ok=true then for i:=2 to n do write(f,d[i],' ');
 close(f); 
end.