Cod sursa(job #1620334)

Utilizator TirauStelianTirau Ioan Stelian TirauStelian Data 29 februarie 2016 07:35:48
Problema Algoritmul lui Dijkstra Scor 100
Compilator fpc Status done
Runda Arhiva educationala Marime 1.42 kb
program bell;
var c,t1,t2,t3,start,d:array[1..500000] of longint;
    viz:array [1..500000] of 0..1;
    n,m:longint;
    bufin,bufout:array[1..1 shl 17] of char;
    f,g:text;
  procedure citire;
  var i,j,k,co:longint;
  begin
    assign(f,'dijkstra.in');assign(g,'dijkstra.out');
    reset(f);rewrite(g);
    settextbuf(f,bufin);settextbuf(g,bufout);
    readln(f,n,m);
    for k:=1 to m do
      begin
        readln(f,i,j,co);
        t1[k]:=j;
        t2[k]:=start[i];
        t3[k]:=co;
        start[i]:=k;
      end;
  end;
  procedure bellman(vf:longint);
  var i,st,dr,p,nod:longint;
    ok:boolean;
  begin
    for i:=2 to n do
      d[i]:=maxlongint;
    d[vf]:=0;
    st:=0;dr:=1;
    c[1]:=vf;
    while (st<dr)  do
      begin
        st:=st+1;
        nod:=c[st];
        viz[nod]:=0;
        p:=start[nod];
        while (p<>0)  do
          begin
            if d[nod]+t3[p]<d[t1[p]] then
              begin
                d[t1[p]]:=d[nod]+t3[p];
                if viz[t1[p]]=0 then
                  begin
                    dr:=dr+1;
                    c[dr]:=t1[p];
                    viz[t1[p]]:=1;
                  end;
              end;
            p:=t2[p];
          end;
      end;
    for i:=2 to n do
      if d[i]<>maxlongint then
        write(g,d[i],' ')
      else
        write(g,'0 ')
  end;
begin
  citire;
  bellman(1);
  close(f);
  close(g);
end.