Cod sursa(job #1359834)

Utilizator mihai1996Toader Mihai mihai1996 Data 25 februarie 2015 08:43:47
Problema Algoritmul Bellman-Ford Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
program bell_man_bun;
const nmax=50001;
      inf=maxlongint;
var t:array[0..2,1..250001] of longint;
    start,d,cd,cc:array[1..nmax] of longint;
    viz:array[1..nmax] of 0..1;
    n,m,nr,aux,ok,u,p,i,j,k,cost,nod:longint;
    f,g:text;

begin
 assign(f,'bellmanford.in'); reset(f);
 assign(g,'bellmanford.out'); rewrite(g);
 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;
 for i:=2 to n do
  d[i]:=inf;
 d[1]:=0; cd[1]:=1;
 u:=1; nr:=1;
 //while (u<n)and(nr<n) do
 for nr:=1 to n do
 begin
  begin
   for i:=1 to u do
    viz[cd[i]]:=0;
   aux:=0;
   for i:=1 to u do
    begin
     nod:=cd[i];
     p:=start[nod];
     while p<>0 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
           viz[t[0,p]]:=1;
           aux:=aux+1;
           cc[aux]:=t[0,p];
          end;
        end;
       p:=t[1,p];
      end;
    end;
   for i:=1 to aux do
    cd[i]:=cc[i];
   u:=aux;
   //nr:=nr+1;
  end;
 end;
 ok:=1;
 for i:=1 to n do
  write(cd[i],' ',u);
 for i:=1 to u do
  begin
   nod:=cd[i];
   p:=start[nod];
   while p<>0 do
    begin
     if d[nod]+t[2,p]<d[t[0,p]] then
       ok:=0;
     p:=t[1,p];
    end;
  end;
 if ok=0 then
  write(g,'Ciclu negativ!')
 else
  for i:=2 to n do
   write(g,d[i],' ');
 close(f);
 close(g);
end.