Cod sursa(job #698833)

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

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

procedure adauga(x,y,cost:longint);
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];
 while cc<>nil do begin
  c:=prim[cc^.y];
  inc(v[cc^.y]);
  if v[cc^.y]>n then begin
    writeln(f,'Ciclu negativ!');
    close(f);
    exit;
  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);

 assign(f,'bellmanford.out');
 dfs;
 for i:=2 to n do write(f,d[i],' ');
 close(f); 
end.