Cod sursa(job #155755)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 12 martie 2008 09:52:56
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.39 kb
type adresa=^nod;
     nod= record inf,cst:longint; adr:adresa; end;


var n,m,i,k:longword;
    m2:word;
    p:array[1..50000] of adresa;
    d:array[1..50000] of longint;
    h,poz:array[1..50000] of word;

procedure citire;
        var f:text;
            i,x,y,c:longword;
            q:adresa;
        begin
        assign(f,'dijkstra.in');
        reset(f);
        readln(f,n,m);
        for i:=1 to m do begin
            readln(f,x,y,c);
            new(q);
             q^.inf:=y; q^.cst:=c;
             q^.adr:=p[x];
             p[x]:=q;

            end;
        close(f);
        end;

procedure scrie;
        var f:text;
            i:longword;
        begin
        assign(f,'dijkstra.out');
         rewrite(f);
         for i:=2 to n do
             write(f,d[i],' ');
         close(f);
        end;


procedure dijkstra_heap;
   var i,min,k,t,pz,p1,c:longword;
       q:adresa;
   begin
   min:=1 shl 30;
   m2:=1 shl 16-1;
   for i:=2 to n do
       begin
       d[i]:=min;
       poz[i]:=m2;
       end;
   d[1]:=0;
   h[1]:=1;
   poz[1]:=1;
   k:=1;
   while k<>0 do begin
         min := h[1];

         t:=h[1]; h[1]:=h[k]; h[k]:=t;
         dec(k);
         poz[h[1]]:=1;

         p1:=1;
         c:=p1 shl 1;
        while (c<=k) do begin
         if (c+1<=k) and (d[h[c]]>d[h[c+1]]) then
                inc(c);
         if (d[h[p1]]>d[h[c]]) then begin
            t:=h[p1]; h[p1]:=h[c]; h[c]:=t;
            poz[h[p1]]:=p1; poz[h[c]]:=c;
            p1:=c;
            c:=c shl 1;
            end else c:=k+1;
        end;

         q:=p[min];
         while q<>nil do
         begin
           if (d[q^.inf]>d[min]+q^.cst) then
           begin
              d[q^.inf]:=d[min]+q^.cst;
              if poz[q^.inf]=m2 then
              begin
                 inc(k); h[k]:=q^.inf; pz:=k; poz[q^.inf]:=k;
              end
              else pz:=poz[q^.inf];
              c:=pz;
              p1:=c shr 1;
              while (p1>=1) do
                 if d[h[p1]]>d[h[c]] then
                 begin
                    t:=h[p1]; h[p1]:=h[c]; h[c]:=t;
                    poz[h[p1]]:=p1; poz[h[c]]:=c;;
                    c:=p1;
                    p1:=p1 shr 1;
                 end else p1:=0;
           end;
           q:=q^.adr;
         end;
   end;
end;

begin
citire;
dijkstra_heap;
scrie;
end.