Cod sursa(job #1420358)

Utilizator ButnaruButnaru George Butnaru Data 18 aprilie 2015 12:43:40
Problema Algoritmul lui Dijkstra Scor 90
Compilator fpc Status done
Runda Arhiva educationala Marime 1.47 kb
program dijkstra;
const inf=999999999;
type
lista=^date;
date=record
m,cost:longint;
next:lista;
end;
vector1=array[0..50001] of lista;
vector2=array[0..50001] of longint;
var t:vector1; heap,pos,d:vector2;
    n,m,i,j,x,y,z,nr:longint; a:lista;
    f1,f2:text;
procedure swap(var a,b:longint);
var aux:longint;
begin aux:=a; a:=b; b:=aux; aux:=pos[a]; pos[a]:=pos[b]; pos[b]:=aux; end;
procedure heapup(v:longint);
var k:longint;
begin
k:=heap[v];
while (v>1) and (d[heap[v]]<d[heap[v div 2]]) do begin
swap(heap[v],heap[v div 2]);
v:=v div 2;
end;
heap[v]:=k;
end;
procedure heapdown(v:longint);
var w:longint;
begin
w:=v*2;
while w<=nr do begin
if (w+1<=nr) and (d[heap[w+1]]<d[heap[w]]) then w:=w+1;
if d[heap[v]]>d[heap[w]] then swap(heap[v],heap[w]) else break;
v:=w; w:=w*2;
end;
end;
procedure delet_heap;
begin
swap(heap[1],heap[nr]); nr:=nr-1;
heapdown(1);
end;
begin
assign (f1,'dijkstra.in');
assign (f2,'dijkstra.out');
reset (f1);
rewrite (f2);
readln (f1,n,m);
for i:=1 to m do begin
readln (f1,x,y,z);
new(a); a^.m:=y; a^.cost:=z; a^.next:=t[x]; t[x]:=a;
end;
for i:=1 to n do begin pos[i]:=i; d[i]:=inf; heap[i]:=i; end;
d[1]:=0; nr:=n;
repeat
x:=heap[1]; a:=t[heap[1]]; delet_heap;
while a<>nil do begin
if a^.cost+d[x]<d[a^.m] then begin
d[a^.m]:=a^.cost+d[x]; heapup(pos[a^.m]);
end;
a:=a^.next;
end;
until nr=0;
for i:=2 to n do
if d[i]=inf then write (f2,0,' ') else write (f2,d[i],' ');
close (f1);
close (f2);
end.