Cod sursa(job #407086)

Utilizator philipPhilip philip Data 2 martie 2010 00:20:12
Problema Algoritmul Bellman-Ford Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.38 kb
type pmuchie=^muchie;
     muchie=record
       v,k:word;
       c:integer;
       next:pmuchie;
     end;
     pnod=^nod;
     nod=record
       v:word;
       next:pnod;
     end;



var n,m,i,x:longint;
    p,nou:pmuchie;
    e:array[0..50000] of pmuchie;
    einc:array[0..50000] of boolean;
    nodnou,nodp,last,first:pnod;
    d:array[0..50000] of longint;



procedure adauga(x:word);
  begin
    if not einc[x] then begin
      new(nodnou);
      nodnou^.v:=x;
      last^.next:=nodnou;
      last:=nodnou;
      last^.next:=nil;
    end;
  end;


begin
  assign(input,'bellmanford.in');
  reset(input);
  assign(output,'bellmanford.out');
  rewrite(output);

  readln(n,m);
  for i:=1 to m do begin
    new(nou);
    readln(x,nou^.v,nou^.c);
    nou^.next:=e[x];
    e[x]:=nou;
  end;

  for i:=2 to n do d[i]:=2000000000;

  new(last);
  adauga(1);
  first:=last;

  while first<>nil do begin
    p:=e[first^.v];
    while p<>nil do begin
      if d[p^.v]>d[first^.v]+p^.c then begin
        d[p^.v]:=d[first^.v]+p^.c;
        inc(p^.k);
        if p^.k>n then begin
          write('Ciclu negativ!');
          close(output);
          halt;
        end;
        adauga(p^.v);
      end;
      p:=p^.next;
    end;
    first:=first^.next;
  end;


  for i:=2 to n do write(d[i],' ');

  close(input);
  close(output);
end.