Cod sursa(job #156806)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 12 martie 2008 19:10:43
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 3.22 kb
   type adresa=^nod;  
      nod= record inf,cst:word; adr:adresa; end;  
   
  const maxlongint:longint=1 shl 31 -1;  
      maxword:word=1 shl 16-1;  
   
  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  
               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.