Cod sursa(job #181417)

Utilizator free2infiltrateNezbeda Harald free2infiltrate Data 18 aprilie 2008 12:23:45
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 2.58 kb
Program dijkstra;
const inf = 50000000;
type pnod = ^nod;
      nod = record
            nod : word;
            cost : longint;
            urm : pnod;
            end;
var A,u : array [1..50000] of pnod;
    urm : pnod;
    H : array [1..50000] of pnod;
    D : array [1..50000] of longint;
    n,x,y,c,lvl : word;
    i,m : longint;
    f,g : text;
procedure shift(n,x:word);
var son : word;
      c : pnod;
begin
repeat
son := 0;
if 2*x<=n then begin
                son := 2*x;
                if 2*x+1<=n then if H[2*x]^.cost>H[2*x+1]^.cost then son := 2*x+1;
                if H[son]>H[x] then son := 0;
                end;
if son<>0 then begin
               c := H[son];
               H[son] := H[x];
               H[x] := c;
               x := son;
               end;
until son=0;
end;

procedure percolate(x:word);
var c : pnod;
begin
if x>1 then
if H[x]^.cost<H[x div 2]^.cost then begin
                                    c := H[x];
                                    H[x] := H[x div 2];
                                    H[x div 2] := c;
                                    percolate(x div 2);
                                    end;
end;


procedure delete;
begin
H[1] := H[lvl];
dec(lvl);
shift(lvl,1);
end;

procedure add(x:pnod);
begin
lvl := lvl+1;
H[lvl] := x;
percolate(lvl);
end;


procedure dijkstra;
var k : word;
begin

while lvl<>0 do begin
k := H[1]^.nod;
delete;
urm := A[k];
while urm<>nil do begin
if D[urm^.nod]>D[k]+urm^.cost then begin
                                   D[urm^.nod] := D[k]+urm^.cost;
                                   add(urm);
                                   end;
urm := urm^.urm;
end;

end;


end;

begin
assign(f,'dijkstra.in');
reset(f);
assign(g,'dijkstra.out');
rewrite(g);

readln(f,n,m);

for i := 1 to n do begin
A[i] := nil;
D[i] := inf;
end;

for i := 1 to m do begin
readln(f,x,y,c);
if A[x]=nil then begin
                 new(A[x]);
                 A[x]^.nod := y;
                 A[x]^.cost := c;
                 A[x]^.urm := nil;
                 u[x] := A[x];
                 end
else begin
     new(urm);
     urm^.nod := y;
     urm^.cost := c;
     urm^.urm := nil;
     u[x]^.urm := urm;
     u[x] := urm;
     end;
end;

lvl := 0;
urm := A[1];
while urm<>nil do begin
inc(lvl);
H[lvl] := urm;
D[urm^.nod] := urm^.cost;
urm := urm^.urm;
end;

for i := lvl div 2 downto 1 do
shift(lvl,i);


dijkstra;

for i := 2 to n do
if D[i]<>inf then write(g,D[i],' ')
             else write(g,'0 ');

close(f);
close(g);
end.