Cod sursa(job #699062)

Utilizator amaliutzzaGoia Amalia amaliutzza Data 29 februarie 2012 17:21:13
Problema Algoritmul Bellman-Ford Scor 35
Compilator fpc Status done
Runda Arhiva educationala Marime 2.21 kb
program bellmanford;

type muchie=record nod, cost:longint; end;

var fi,fo:Text;
    n,m:longint;
    a:array of array of muchie;
    cd:array[1..1000000]of longint;
    viz,d:Array[1..500000]of longint;



  procedure citire;
  var i,col,x,y,z:longint;
  begin
      readln(fi,n,m);
      setlength(a,n+1,1);

     { for i:=1 to m do
 begin
  readln (fi,x,y,z);
  setlength (a[x],length (a[x])+1);
  a[x,0].nod:=a[x,0].nod+1;
  a[x,a[x,0].nod].nod:=y;
  a[x,a[x,0].nod].cost:=z;
 end; }

      for i:=1 to m do
        begin
            readln(Fi,x,y,z);
            a[x,0].nod:=a[x,0].nod+1;
            col:=a[x,0].nod;
            setlength(A[x], length(a[x])+1);
            a[x,col].nod:=y;
            a[x,col].cost:=z;
        end;
  end;

  procedure bellman;
  var pi,ps,nodstart,el,unde,nod,cost,i:longint;
  begin
      ps:=1; pi:=1; nodstart:=1;
      cd[pi]:=nodstart;
      for i:=2 to n do
        d[i]:=maxlongint;
      viz[1]:=1;
      while ps<=pi do
        begin
         { if ps>=1000000 then
            begin
                writeln(fo,'Circuit negativ!');
                close(fi); close(Fo); halt;
            end; }

            el:=cd[ps];
            viz[cd[ps]]:=0;

            unde:=a[el,0].nod; //pana unde am vecini ai lui el in "matrice"
            for i:=1 to unde do
              begin
                  nod:=a[el,i].nod;
                  cost:=a[el,i].cost;
                  if d[nod]>d[el]+cost then
                    begin
                        d[nod]:=d[el]+cost;
                        if viz[nod]=0 then
                          begin
                              viz[nod]:=1;
                              inc(pi);
                              cd[pi]:=nod;
                          end;
                    end;
              end;

            inc(ps);
        end;
  end;

  procedure afisare;
  var i:integer;
  begin
      for i:=2 to n do
       if d[i]=maxlongint then write(fo,'0 ') else
        write(fo,d[i],' ');
  end;

begin
    assign(fi,'bellmanford.in'); reset(fi);
    assign(fo,'bellmanford.out'); rewrite(fo);

      citire;
      bellman;
      afisare;

    close(Fi); close(Fo);
end.