Cod sursa(job #1412855)

Utilizator ButnaruButnaru George Butnaru Data 1 aprilie 2015 16:47:19
Problema Algoritmul Bellman-Ford Scor 75
Compilator fpc Status done
Runda Arhiva educationala Marime 0.99 kb
//Bellman Ford
program bellman;
type
lista=^date;
date=record
m,cost:integer;
next:lista;
end;
    tabel=array[0..50001] of lista;
    tabb=array[0..400001] of longint;
    tabb1=array[0..100001] of longint;
var t:tabel; coada:tabb; fr,d:tabb1;
    a:lista; ok:boolean;
    n,m,i,j,x,y,z,pr,ul:longint;
    f1,f2:text;
begin
assign (f1,'bellmanford.in');
assign (f2,'bellmanford.out');
reset (f1);
rewrite (f2);
readln (f1,n,m);
for i:=1 to m do begin
readln (f1,x,y,z);
new(a); a^.m:=y; a^.cost:=z; a^.next:=t[x]; t[x]:=a; end;
ok:=true;
for i:=2 to n do d[i]:=maxlongint;
ul:=1; coada[ul]:=1; pr:=0;
repeat
pr:=pr+1; x:=coada[pr]; a:=t[x];
while a<>nil do begin
if d[x]+a^.cost<=d[a^.m] then begin
d[a^.m]:=d[x]+a^.cost; ul:=ul+1; coada[ul]:=a^.m;
fr[a^.m]:=fr[a^.m]+1;
if fr[a^.m]=n then ok:=false;
end;
a:=a^.next;
end;
until (pr=ul) or (not ok);
if not ok then writeln (f2,'Ciclu negativ!') else
for i:=2 to n do write (f2,d[i],' ');
close (f1);
close (f2);
end.