Cod sursa(job #1373264)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 4 martie 2015 17:40:29
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.39 kb
program mire;
var t:array[0..2,0..500000] of longint;
     f,g:text;
     m,n:longint;
     viz:array[1..50000] of 0..1;
     co,start,d:array[1..50000] of longint;
procedure citire;
var k,i,x,y,c:longint;
begin
  assign(f,'dijkstra.in'); reset(f);
    readln(f,n,m);
    k:=0;
    for i:=1 to m do
      begin
         readln(f,x,y,c);
         inc(k);
         t[0,k]:=y;
         t[1,k]:=start[x];
         start[x]:=k;
         t[2,k]:=c;
      end;
  close(f);
end;
procedure bellman;
var i,st,sf,p,nod:longint;
begin
   for i:=2 to n do
     d[i]:=maxlongint;
   d[1]:=0;
   co[1]:=1;
   st:=0; sf:=1;
   while st<sf do
     begin
        inc(st);
        nod:=co[st];
        viz[nod]:=0;
        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
                  inc(sf);
                  co[sf]:=t[0,p];
                  viz[co[sf]]:=1;
                end;
               end;
              p:=t[1,p];
          end;
     end;

end;
procedure afis;
var i:longint;
begin
  assign(g,'dijkstra.out'); rewrite(g);
    for i:=2 to n do
      if d[i]<>maxlongint then
        write(g,d[i],' ')
      else
       write(g,0);
  close(g);
end;
begin
 citire;
 bellman;
 afis;
end.