Cod sursa(job #158458)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 13 martie 2008 17:35:58
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 2.86 kb
   type adresa=^nod;
      nod= record inf,cst:word; adr:adresa; end;

  const maxword=2*maxint;

  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
      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;
              p1:=c; c:=p1 shl 1;
              end
           else
              break;

           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;
                   c:=p1;
                   p1:=c shr 1;
                   end
                else
                  break;

                end;
             end;
          q:=q^.adr;
          end;

         end;
     end;



  begin
  citire;
  dijkstra_heap;
  scrie;
  end.