Cod sursa(job #581498)

Utilizator andreifirstCioara Andrei Ioan andreifirst Data 14 aprilie 2011 11:48:27
Problema Algoritmul Bellman-Ford Scor 35
Compilator fpc Status done
Runda Arhiva educationala Marime 1.22 kb
type muchie=^nod;
     nod = record n, c:longint; a:muchie; end;

var v:array[1..50000] of muchie;
    d:array[1..50000] of longint;
    buf1, buf2:array [1..1 shl 17] of char;
    m, n, i, j, k, x, y, c:longint;
    f, g:text;
    p:muchie;
    ok:boolean;

begin
assign (f, 'bellmanford.in'); settextbuf (f, buf1); reset (f);
assign (g, 'bellmanford.out'); settextbuf (g, buf2); rewrite (g);

readln (f, n, m);
for i := 2 to n do d[i]:=maxlongint;
d[1]:=0;

for i := 1 to m do
  begin
  readln (f, x, y, c);
  if v[x]= nil then begin new(v[x]); v[x]^.a:=nil; v[x]^.n:=y; v[x]^.c:=c; end
               else begin new (p); p^.c:=c; p^.n:=y; p^.a:=v[x]; v[x]:=p; end;
  end;

for i := 1 to n do
  begin
  ok:=false;
  for j := 1 to n do
    begin
    if d[j]<>maxlongint then
      begin
      p:=v[j];
      while p<> nil do
        begin
        if int64 (d[j]+p^.c) < d[p^.n] then
          begin
          d[p^.n]:=d[j]+p^.c;
          ok:=true;
          end;
        p:=p^.a;
        end;
      end;
    end;
  end;


if ok then writeln (g, 'Ciclu negativ!')
      else for i := 2 to n do if d[i]=maxlongint then write (g, '0 ') else write (g, d[i], ' ');

close (f); close (g);
end.