# Cod sursa(job #340092)

Utilizator Data 13 august 2009 01:04:19 Algoritmul lui Dijkstra 0 fpc done Arhiva educationala 2.44 kb
``````program dijkstra;
const inf=maxint*2-1000;
type  vector=^nod;
nod=record
dest,cost:word;
next:vector;
end;

var a,b:text;
i,j,k,N,M,aa,bb,cc,hind,S,u,vv,alt:word;
dist:array[0..50000] of longint;
heap,poz:array[0..50000] of word;
v:array[1..50000] of vector;
root:vector;
procedure push_back(aa,bb,cc:word); begin
root:=v[aa];
while (root<>nil) and (root^.next<>nil) do root:=root^.next;
if (root=nil) then
begin
new(v[aa]);
root:=v[aa];
end else
begin
new(root^.next);
root:=root^.next;
end;
root^.next:=nil;
root^.dest:=bb;
root^.cost:=cc;
end;
procedure swap(i,j:word);
var t:word;
begin
t:=heap[i];
heap[i]:=heap[j];
heap[j]:=t;
poz[heap[i]]:=i;
poz[heap[j]]:=j;
end;
procedure upheap(i:word);
var x:word;
begin
x:=0;
while (x<>i) do begin
x:=i;
if (dist[heap[i]]<dist[heap[i div 2]]) then i:=i div 2;
swap(i,x);
end;
end;
procedure downheap(i:word);
var x:word;
begin
x:=0;
while (x<>i) do begin
x:=i;
if (2*x<=hind) and (dist[heap[2*x]]<dist[heap[i]]) then i:=2*x;
if (2*x+1<=hind) and (dist[heap[2*x+1]]<dist[heap[i]]) then i:=2*x+1;
swap(i,x);
end;
end;
procedure delete(i:word);
begin
poz[heap[i]]:=-1;
swap(hind,i);
dec(hind);
downheap(i);
end;
begin
dist[0]:=-1;
assign(a,'dijkstra.in');
assign(b,'dijkstra.out');
reset(a);
rewrite(b);
s:=1;
for i:=1 to N do
v[i]:=nil;
for i:=1 to N do
begin
push_back(aa,bb,cc);
end;
hind:=N;
for i:=1 to N do
begin
dist[i]:=inf;
heap[i]:=i;
poz[i]:=i;
end;
dist[S]:=0;
upheap(poz[S]);
while (hind>0) do
begin
u:=heap[1];
delete(1);
root:=v[u];
while (root<>nil) do
begin
alt:=dist[u]+root^.cost;
if (alt<dist[root^.dest]) then
begin
dist[root^.dest]:=alt;
upheap(poz[root^.dest]);
end;
root:=root^.next;
end;
end;
for i:=1 to N do
if (i<>S) then Write(b,dist[i], ' ');
close(b);
end.``````