Cod sursa(job #1360070)

Utilizator mariusadamMarius Adam mariusadam Data 25 februarie 2015 11:22:30
Problema Algoritmul Bellman-Ford Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
program bell_man_bun;
const nmax=50001;
      inf=maxlongint;
var t:array[0..2,1..250001] of longint;
    start,d,count:array[1..nmax] of longint;
    cd:array[1..400000] of longint;
    bufin,bufout:array[1..250001] of byte;
    viz:array[1..nmax] of 0..1;
    n,m,nr,ok,st,sf,p,i,j,k,cost,nod:longint;
    f,g:text;

function bellman_ford:boolean;
var ok:boolean;
begin
  for i:=2 to n do
  d[i]:=inf;
 d[1]:=0; cd[1]:=1; ok:=true;
 st:=1; sf:=1; count[1]:=1;
  while (st<=sf)and(ok) do
   begin
    nod:=cd[st];
    viz[nod]:=0;
    p:=start[nod];
    while (p<>0)and(ok) do
     begin
      if (d[nod]+t[2,p]<d[t[0,p]]) then
       begin
        d[t[0,p]]:=d[nod]+t[2,p];
        if viz[t[0,p]]=0 then
         begin
          count[t[0,p]]:=count[t[0,p]]+1;
          viz[t[0,p]]:=1;
          sf:=sf+1;
          cd[sf]:=t[0,p];
         end;
        if count[t[0,p]]>n-1 then
         ok:=false;
       end;
      p:=t[1,p];
     end;
    st:=st+1;
   end;
 bellman_ford:=ok;
end;

begin
 assign(f,'bellmanford.in'); reset(f);
 assign(g,'bellmanford.out'); rewrite(g);
 settextbuf(f,bufin); settextbuf(g,bufout);
 readln(f,n,m);
 for k:=1 to m do
  begin
   readln(f,i,j,cost);
   t[0,k]:=j;
   t[1,k]:=start[i];
   t[2,k]:=cost;
   start[i]:=k;
  end;
 if not bellman_ford then
  write(g,'Ciclu negativ!')
 else
  for i:=2 to n do
   write(g,d[i],' ');
 close(f);
 close(g);
end.