Cod sursa(job #380887)

Utilizator cristinabCristina Brinza cristinab Data 7 ianuarie 2010 23:55:40
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
{algoritmu bellman ford}

const inf=maxlongint div 2;

type ref=^nod;
     nod=record
         vf,c:longint;
         urm:ref;
         end;

var prim:array[1..50001] of ref;
    d,tata:array[1..50001] of longint;
    n,m:longint;

procedure adaug(x,y,cost:longint);
var c:ref;
begin
new(c);
c^.vf:=y;
c^.c:=cost;
c^.urm:=prim[x];
prim[x]:=c;
end;

procedure citire;
var i,x,y,cost:longint;
begin
assign(input,'dijkstra.in'); reset(input);
readln(n,m);
for i:=1 to m do
    begin
    readln(x,y,cost);
    adaug(x,y,cost);
    end;
close(input);
end;

procedure bellman;
var varf,i:longint;
    p:ref;
    ok:boolean;
begin
for i:=1 to n do
    begin
    d[i]:=inf;
    tata[i]:=0;
    end;

varf:=1;
ok:=true;
d[1]:=0;

while ok and (varf<n) do
      begin

      ok:=false;

      for i:=1 to n do
          begin
          p:=prim[i];
          while p<>nil do
                begin
                if d[p^.vf]>d[i]+p^.c then
                   begin
                   d[p^.vf]:=d[i]+p^.c;
                   tata[p^.vf]:=i;
                   ok:=true;
                   end;
                p:=p^.urm;
                end;
          end;
     inc(varf);
     end;
end;

procedure afisare;
var i:longint;
begin
assign(output,'dijkstra.out'); rewrite(output);
for i:=2 to n do
    if d[i]=inf then write(0,' ')
                else write(d[i],' ');
close(output);
end;

begin
citire;
bellman;
afisare;
end.