Cod sursa(job #157135)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 12 martie 2008 21:25:00
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 2.66 kb
type adresa=^nod;
     nod= record inf,cst:longint; adr:adresa; end;

const maxlongint:longint=1 shl 31 -1;
      maxword:word=1 shl 16-1;

var n,m,i,k:longint;
    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:longint;
            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:longint;
        begin
        assign(f,'dijkstra.out');
         rewrite(f);
         for i:=2 to n do
            if d[i]<>maxlongint then
             write(f,d[i],' ')
            else
             write(f,0,' ');
         close(f);
        end;


procedure dijkstra_heap;
   var min,i,k,p1,c,inf,t,pz:longint;
       m2:word;
       q:adresa;
   begin
   maxlongint:=1 shl 31 -1;
   maxword:=1 shl 16-1;
   for i:=2 to n do
       begin
       d[i]:=maxlongint;
       poz[i]:=maxword;
       end;
   d[1]:=0; poz[1]:=1; h[1]:=1;
   k:=1;
   while k<>0 do
       begin
       min:=h[1];
       t:=h[1]; h[1]:=h[k]; h[k]:=t;
       k:=k-1;  poz[h[1]]:=1;
       //corrct heap jos
       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[c]]<d[h[p1]]) then
           begin
           t:=h[c]; h[c]:=h[p1]; h[p1]:=t;
           poz[h[c]]:=c;
           poz[h[p1]]:=p1;
           end
        else
           break;
        p1:=c; c:=p1 shl 1;
        end;
       q:=p[min];
       while q<>nil do
        begin
        if (d[min]+q^.cst<d[q^.inf]) then
           begin
           d[q^.inf]:=d[min]+q^.cst;
           if poz[q^.inf]=maxword then
              begin
              inc(k); h[k]:=q^.inf; poz[h[k]]:=k;
              c:=k;
              end
           else
              c:=poz[q^.inf];
           p1:=c shr 1;
           while (p1>=1) do
              begin
              if (d[h[c]]<d[h[p1]]) then
                 begin
                 t:=h[c]; h[c]:=h[p1]; h[p1]:=t;
                 poz[h[c]]:=c;
                 poz[h[p1]]:=p1;
                 end
              else
                break;
              c:=p1;
              p1:=c shr 1;
              end;
           end;
        q:=q^.adr;
        end;

       end;
   end;



begin
citire;
dijkstra_heap;
scrie;
end.