Cod sursa(job #155896)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 12 martie 2008 11:18:08
Problema Algoritmul lui Dijkstra Scor 30
Compilator fpc Status done
Runda Arhiva educationala Marime 2.64 kb
type adresa=^nod;
     nod= record
          inf,dist:longint;
          adr:adresa;
          end;

var  n,m,x,y,c,i,k,tmp,pz,min:longint;
     q,p:adresa;
     vc:array[1..50000]of adresa;
     d:array[1..50000]of longint;
     h,poz:array[1..50000]of longint;
procedure citire;
begin
     assign(input,'dijkstra.in');
     reset(input);
     read(n,m);
     for i:=1 to n do
         vc[i]:=nil;
     for i:=1 to m do
     begin
          new(q);
          read(x,y,c);
          q^.inf:=y;
          q^.dist:=c;
          q^.adr:=vc[x];
          vc[x]:=q;
     end;
     close(input);
end;
procedure corect_sus(ph:longint);
var c,t:longint;
begin
     c:=ph;
     t:=ph div 2;

     while(t>=1)and(d[h[c]]<d[h[t]])do
     begin
          tmp:=h[c];
          h[c]:=h[t];
          h[t]:=tmp;
          tmp:=poz[c];
          poz[c]:=poz[t];
          poz[t]:=tmp;
          c:=t;
          t:=t div 2;
     end;
end;

procedure corect_jos(ph:longint);
var c,t:longint;
begin
     t:=ph;
     c:=t*2;
     while(c<=k)do
     begin
          if(c+1<=k)and(d[h[c]]>d[h[c+1]])then
          c:=c+1;
          if(d[h[c]]<d[h[t]])then
          begin
               tmp:=h[c];
               h[c]:=h[t];
               h[t]:=tmp;
               tmp:=poz[c];
               poz[c]:=poz[t];
               poz[t]:=tmp;

          end
          else
          c:=k+1;
     end;

end;

procedure dijkstra;
begin
     for i:=2 to n do
     d[i]:=maxlongint;

     for i:=2 to n do
     poz[i]:=-1;

     h[1]:=1;
     poz[1]:=1;

     k:=1;
     while k>0 do
     begin
          min:=h[1];

          tmp:=h[1];
          h[1]:=h[k];
          h[k]:=tmp;
          poz[h[1]]:=1;

          k:=k-1;

          corect_jos(1);

          p:=vc[min];
          while p<>nil do
          begin
               if(d[min]+p^.dist<d[p^.inf])then
               begin
                    d[p^.inf]:=d[min]+p^.dist;
                    if (poz[p^.inf]=-1) then
                    begin
                         k:=k+1;
                         h[k]:=p^.inf;
                         poz[p^.inf]:=k;
                         pz:=k;
                    end
                    else pz:=poz[p^.inf];

                    corect_sus(pz);

               end;
               p:=p^.adr;
          end;
     end;

end;
procedure scriere;
begin
     assign(output,'dijkstra.out');
     rewrite(output);
     for i:=2 to n do
         if(d[i]<>maxlongint)then
         write(d[i],' ')
         else
         write('0 ');
     close(output);
end;

begin
citire;
dijkstra;
scriere;
end.