Cod sursa(job #1358171)

Utilizator casianos1996Marc Casian Nicolae casianos1996 Data 24 februarie 2015 13:53:28
Problema Algoritmul Bellman-Ford Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 2.2 kb
program bellman;

const   infile='bellmanford.in';
        outfile='bellmanford.out';
        maxn=50003;
        infinit=1000000000;

type    nod=^pnod;
        pnod=record
          vf:longint;
          urm:nod;
        end;

        coada=record
          prim,ultim:nod;
        end;

        list=^vec;

        vec=record
          inf,cost:longint;
          next:list;
        end;

var     a:array[1..maxn]of list;
        inq,d:array[1..maxn]of longint;
        q:coada;
        n,m:longint;

procedure citire;
var       i,j,c:longint;
          p:list;
begin
  assign(input,infile);
  reset(input);
  readln(n,m);
  while(m>0)do
    begin
      readln(i,j,c);
      dec(m);
      new(p);
      p^.inf:=j;
      p^.cost:=c;
      p^.next:=a[i];
      a[i]:=p;
    end;
  close(input);
end;

procedure pop;
var       r:nod;
begin
  with q do
    begin
      r:=prim;
      prim:=prim^.urm;
      dispose(r);
    end;
end;

procedure push(x:longint);
var       r:nod;
begin
  with q do
    if(prim=nil)then
      begin
        new(prim);
        prim^.vf:=x;
        prim^.urm:=nil;
        ultim:=prim;
       end
     else
       begin
         new(r);
         r^.vf:=x;
         r^.urm:=nil;
         ultim^.urm:=r;
         ultim:=r;
       end;
end;

function BellmanFord:boolean;
var      p:list;
         x,i:longint;
         ok:boolean;
begin
  for i:=2 to n do
    d[i]:=infinit;
  ok:=true;
  push(1);
  d[1]:=0;
  inq[1]:=1;
  while (q.prim<>nil) and (ok) do
    begin
      x:=q.prim^.vf;
      pop;
      p:=a[x];
      while(p<>nil)do
        begin
          if (d[p^.inf]>d[x]+p^.cost) then
            begin
              d[p^.inf]:=d[x]+p^.cost;
              push(p^.inf);
              inc(inq[p^.inf]);
            end;
          if (inq[p^.inf]>=n) then
            ok:=false;
          p:=p^.next;
        end;
     end;
  BellmanFord:=ok;
end;

procedure afisare;
var       i:longint;
begin
  assign(output,outfile);
  rewrite(output);
  if BellmanFord then
    for i:=2 to n do
      write(d[i],' ')
  else write('Ciclu negativ!');
  close(output);
end;

Begin
  citire;
  afisare;
End.