Cod sursa(job #1405456)

Utilizator ButnaruButnaru George Butnaru Data 29 martie 2015 11:41:12
Problema Floyd-Warshall/Roy-Floyd Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.56 kb
//Algoritmul lui Dijkstra//
program dijkstra;
const inf=9999999;
type
lista=^date;
date=record
m,cost:longint;
next:lista;
end;
tabel=array[0..50001] of lista;
tabb=array[0..50001] of longint;
buf=array[0..1 shl 17] of char;
var
heap,d,pos:tabb; t:tabel;
ff1,ff2:buf; a:lista;
n,i,j,m,x,y,z,nr:longint;
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 heapdown(v:longint);
var w:longint;
begin
w:=v*2;
while w<=nr do begin
if (w<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 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 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);
settextbuf(f1,ff1);
settextbuf(f2,ff2);
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 d[i]:=inf; heap[i]:=i; pos[i]:=i; end;
d[1]:=0; nr:=n;
repeat
a:=t[heap[1]]; x:=heap[1]; delet_heap;
while a<>nil do begin
if d[x]+a^.cost<d[a^.m] then begin
d[a^.m]:=d[x]+a^.cost; 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.