Cod sursa(job #1635071)

Utilizator mirelabocsabocsa mirela mirelabocsa Data 6 martie 2016 14:55:19
Problema Algoritmul lui Dijkstra Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 2.07 kb
program mire;
var t:array[0..2,0..500000] of longint;
   start,d,fr:array[0..50000] of longint;
   co,poz,h,tata:array[0..500000] of longint;
   viz:array[1..50000] of 0..1;
   f,g:text;
   n,m,u,i:longint;
   ok:boolean;
procedure citire;
var i,k,x,y,c:longint;
begin
 assign(f,'dijkstra.in'); reset(f);
 assign(g,'dijkstra.out'); rewrite(g);
   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];
      t[2,k]:=c;
      start[x]:=k;
    end;
 close(f);
end;
procedure swap(q,w:longint);
var aux:longint;
begin
  aux:=h[q];
  h[q]:=h[w];
  h[w]:=aux;
  aux:=poz[h[q]];
  poz[h[q]]:=poz[h[w]];
  poz[h[w]]:=aux;
end;
procedure sift(k:integer);
var son,aux,l,r:integer;
begin
 repeat
   son:=0;
   l:=2*k;
   r:=2*k+1;
   if l<=n then
     begin
       son:=l;
       if (r<=n)and (h[r]<h[l]) then
          son:=r;
       if h[son]>=h[k] then
         son:=0;
     end;
   if son<>0 then
     begin
       swap(k,son);
       k:=son;
     end;
 until son=0;
end;
procedure percolate( k:integer);
var key:integer;
begin
  while (k>1) and (h[k]<h[k div 2]) do
    begin
      swap(k,k div 2);
      k:=k div 2;
    end;
end;

procedure dij;
var k,p,nod,aux,i,st,sf:longint;
begin
  d[1]:=0;
  m:=n;
  for i:=1 to m do
     begin
        nod:=h[1];
        swap(1,n);
        n:=n-1;
        sift(1);
        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];
                   tata[t[0,p]]:=nod;
                   percolate(poz[t[0,p]]);
                end;
             p:=t[1,p];

          end;
     end;
end;
begin
  citire;
  for i:=1 to n do
     begin
       d[i]:=maxlongint-maxint;
       h[i]:=i;
       poz[i]:=i;
     end;
   dij;
        for i:=2 to m do
         if d[i]<>maxlongint-maxint then
                 write(g,d[i],' ')
              else
                write(g,0,' ');
 close(g);
end.