Cod sursa(job #401191)

Utilizator nickyyLal Daniel Emanuel nickyy Data 22 februarie 2010 16:21:30
Problema Algoritmul lui Dijkstra Scor 70
Compilator fpc Status done
Runda Arhiva educationala Marime 2.14 kb
const infile='dijkstra.in';
  outfile='dijkstra.out';
  maxn=50003;
  inf=50000003;
type list=^nod;
  nod=record
        inf,cost:integer;
        next:list;
        end;
var a:array[0..maxn]of list;
  d:array[0..maxn]of 0..inf;
  h,up:array[0..maxn]of longint;
  n,m,st,vf:longint;

 procedure citire;
 var f:text;
   i,j,k:integer;
   p:list;
 begin
   assign(f,infile); reset(f); readln(f,n,m);
   while(m>0)do begin
     readln(f,i,j,k); new(p); p^.inf:=j; p^.cost:=k;
     p^.next:=a[i]; a[i]:=p; dec(m);
     end;
   close(f);
 end;

 procedure init;
 var i:integer;
 begin
   st:=1;
   for i:=1 to n do begin d[i]:=inf; up[i]:=-1; end;
   d[st]:=0; inc(vf); h[vf]:=st; up[st]:=1;
 end;

 procedure combinare;
 var v,tata,fiu:integer;
 begin
   tata:=1; fiu:=tata*2; v:=h[tata];
   while(fiu<=vf)do begin
     if(fiu<vf)and(d[h[fiu]]>d[h[fiu+1]])then inc(fiu);
     if(d[v]>d[h[fiu]])then begin
       up[h[tata]]:=fiu; up[h[fiu]]:=tata;
       v:=h[tata]; h[tata]:=h[fiu]; h[fiu]:=v;
       tata:=fiu; fiu:=fiu*2;
       end
     else fiu:=vf+1;
     end;
 end;

 function ExMinim:integer;
 begin
   ExMinim:=h[1]; h[1]:=h[vf]; dec(vf); combinare;
 end;

 procedure insert(vf:integer);
 var v,tata,fiu:integer;
 begin
   v:=h[vf]; fiu:=vf; tata:=vf div 2;
   while(tata<>0)and(d[h[tata]]>d[v])do begin
     up[h[fiu]]:=tata; up[h[tata]]:=fiu;
     v:=h[fiu]; h[fiu]:=h[tata]; h[tata]:=v;
     fiu:=tata; tata:=fiu div 2;
     end;
 end;

 procedure relaxeaza(u,v,w:integer);
 begin
   if(d[v]>d[u]+w)then begin
     d[v]:=d[u]+w;
     if(up[v]<>-1)then insert(up[v])
     else begin inc(vf); h[vf]:=v; up[v]:=vf; insert(vf); end;
     end;
 end;

 procedure dijkstra;
 var i,min:integer;
   p:list;
 begin
   init;
   while(vf>0)do begin
     min:=ExMinim; p:=a[min];
     while(p<>nil)do begin relaxeaza(min,p^.inf,p^.cost); p:=p^.next; end;
     end;
 end;

 procedure scrie;
 var f:text;
   i:integer;
 begin
   assign(f,outfile); rewrite(f);
   for i:=2 to n do
    if(d[i]<>inf)then write(f,d[i],' ')
    else write(f,0,' ');
   close(f);
 end;

begin
citire; dijkstra; scrie;
end.