Cod sursa(job #381036)

Utilizator andrei31Andrei Datcu andrei31 Data 8 ianuarie 2010 17:13:14
Problema Algoritmul lui Dijkstra Scor 80
Compilator fpc Status done
Runda Arhiva educationala Marime 2.69 kb
const inf=250000002;
type ref=^lista;
     lista=record
           vf:word;
           c:longint;
           leg:ref;
           end;

var g:array[1..50000] of ref;
    h,poz:array[1..50000] of word;
    d:array[1..50000] of longint;
    n,x0,nv:word;
    m:longint;

procedure adauga(x,y,c:word);
var p:ref;
begin
new(p);p^.vf:=y;p^.c:=c;p^.leg:=g[x];g[x]:=p;
end;

procedure citeste;
var x,y,c:word;
    i:longint;
begin
assign(input,'dijkstra.in');reset(input);
readln(n,m);
for i:=1 to m do
begin
readln(x,y,c);
adauga(x,y,c);
end;
i:=1;
nv:=0;
close(input);
end;

procedure comb(i:word);
var l,r:longint;
    aux,go:word;
begin

while  i<=nv div 2 do
 begin
l:=2*i;r:=2*i+1;
go:=i;
if (l<=nv) and (d[h[l]]<d[h[i]]) then go:=l;
if (r<=nv) and (d[h[r]]<d[h[i]]) and (d[h[r]]<d[h[go]]) then go:=r;
if go<>i then begin
             aux:=h[go];
             h[go]:=h[i];
             h[i]:=aux;
             poz[h[go]]:=go;
             poz[h[i]]:=i;
             i:=go;
             end else exit;
  end;
end;


procedure heapup(k:word);
var aux:word;
begin
while (k div 2>0) and (d[h[k div 2]]>d[h[k]]) do
                begin
                aux:=h[k];
                h[k]:=h[k div 2];
                h[k div 2]:=aux;
                poz[h[k]]:=k;
                poz[h[k div 2]]:=k div 2;
                k:=k div 2;
                end;
end;


function elim:word;
var aux:word;
begin
elim:=h[1];
aux:=h[1];
h[1]:=h[nv];
h[nv]:=aux;
dec(nv);
comb(1);
end;

procedure formheap;
var i:word;
begin
for i:=nv div 2 downto 1 do
comb(i);
end;

procedure dijkstra;
var p:ref;
    i,k:word;
begin
p:=g[x0];
for i:=1 to n do
begin
d[i]:=inf;
{h[i]:=i;
poz[i]:=i; }
end;

while p<>nil do
 begin
 d[p^.vf]:=p^.c;
 inc(nv);
 h[nv]:=p^.vf;
 poz[p^.vf]:=nv;
 heapup(poz[p^.vf]);
 p:=p^.leg;
 end;
{formheap;}
k:=5;
while (nv>0)  do
 begin
 k:=elim;if d[k]=inf then exit;
  p:=g[k];
 while p<>nil do begin
  if d[k]+p^.c<d[p^.vf] then  begin
                            d[p^.vf]:=d[k]+p^.c;
                            if poz[p^.vf]=0 then
                                 begin
                                 inc(nv);
                                 poz[p^.vf]:=nv;
                                 h[nv]:=p^.vf;
                                 end;
                            heapup(poz[p^.vf]);
                            end;
  p:=p^.leg;

  end;
  end;
end;


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

begin
citeste; x0:=1;
dijkstra;
afisare;
end.