Cod sursa(job #156098)

Utilizator hitmannCiocas Radu hitmann Data 12 martie 2008 12:46:18
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 2.54 kb
program distante;
const
pinfinit=1.e20;
type pnod=^nod;
     nod=record
         nod:longint;
         i:longint;
         urm:pnod;
         end;
     cheie=record
           val:real;
           poz:longint;
           end;
var a:array[1..50000]of pnod;
    d:array[1..50000]of real;
    s,id:array[1..50000]of longint;
    h:array[1..50000]of cheie;
    i,poz,r,n,m,dheap,he:longint;
    p:pnod;
    t,q:byte;
    ok:boolean;
    min:real;
    f,g:text;
procedure citire;
var z,y,x:longint;
begin
read(f,n,m,r);
for i:=1 to n do begin d[i]:=pinfinit;end;
for i:=1 to m do begin

 read(f,x,y,z);
 new(p); p^.nod:=y;
 p^.i:=z; p^.urm:=a[x]; a[x]:=p;
  end;
end;
procedure recon_heap(i:longint);
var l,r,max:longint;
    aux:cheie;
begin
l:=i shl 1;
r:=l+1;
if (l<=dheap)and(h[l].val<h[i].val) then max:=l
                        else max:=i;
if (r<=dheap)and(h[r].val<h[max].val) then max:=r;
if max<>i then
          begin

          if ok then begin id[h[max].poz]:=id[h[max].poz] div 2;
                       id[he]:=max;end;
          aux:=h[i]; h[i]:=h[max]; h[max]:=aux;

          recon_heap(max);
          end;
end;
procedure heap;
begin
for i:=n div 2 downto 1 do
  recon_heap(i);
end;
procedure dec_key(i:integer;val:real);
var aux:cheie;
    a1:longint;
begin
h[i].val:=val;
while (i>1) and (h[i div 2].val>h[i].val) do
begin
aux:=h[i];
 a1:=id[h[i].poz];id[h[i].poz]:=id[h[i div 2].poz];id[h[i div 2].poz]:=a1;
 h[i]:=h[i div 2]; h[i div 2]:=aux;
i:=i div 2;
end;
end;
begin {pp}
assign(f,'dijkstra.in'); reset(f); assign(g,'dijkstra.out'); rewrite(g);
r:=1;
citire;
s[r]:=1;
p:=a[r];
while p<>nil do
 begin
 d[p^.nod]:=p^.i; writeln('=',p^.i);
 p:=p^.urm;
 end;
d[r]:=0;
dheap:=0;
 for i:=1 to n do
 if i<>r then begin
              inc(dheap);
              h[dheap].val:=d[i];
              h[dheap].poz:=i;
              end;
ok:=false;
heap;
for i:=1 to dheap do id[h[i].poz]:=i;
while dheap>0 do
begin
ok:=true;
min:=pinfinit;
poz:=0;
poz:=h[1].poz;
min:=h[1].val;
h[1]:=h[dheap]; id[h[dheap].poz]:=1;
  dec(dheap);
  he:=h[1].poz;
  recon_heap(1);
s[poz]:=1;
p:=a[poz];
while p<>nil do
   begin
if s[p^.nod]=0 then if d[p^.nod]>d[poz]+p^.i then
             begin
           d[p^.nod]:=d[poz]+p^.i;
           dec_key(id[p^.nod],d[p^.nod]);
             end;

   p:=p^.urm;
    end;
end;
ok:=true;
for i:=2 to n do if d[i]<>pinfinit then write(g,d[i]:0:0,' ')
                                   else write(g,0,' ');
close(g); close(f);
end.