Cod sursa(job #390692)

Utilizator yoannaserb ioana yoanna Data 4 februarie 2010 12:57:35
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.15 kb
program algoritm_dijkstra;
var x:array[1..50000,1..50000] of integer;
    d:array[1..50000] of integer; n:longint;
procedure citire;
var m,a,b,k,i,j:longint;
    c:integer;
    f:text;
begin
assign(f,'dijkstra.in'); reset(f);
readln(f,n,m);
for k:=1 to m do
begin
readln(f,a,b,c);
x[a,b]:=c;
end;
for i:=1 to n do
for j:=1 to n do
if x[i,j]=0 then
x[i,j]:=10000;
close(f);
end;
procedure afisare;
var i,j:longint;
begin
for i:=1 to n do
begin
for j:=1 to n do
write(x[i,j],' ');
writeln;
end;
end;
procedure dijkstra;
var m:array[1..50000] of boolean;
    ok:boolean;
    i,j,p:longint; min:integer;
begin
for i:=2 to n do
m[i]:=false;
m[1]:=true;
for i:=2 to n do
d[i]:=x[1,i];
ok:=true;
while ok do
begin
i:=2;
while m[i]=true do
i:=i+1;
p:=i;
min:=d[i];
for j:=i to n do
if (d[j]<min) and (m[j]=false) then
begin
min:=d[j];
p:=j;
end;
m[p]:=true;
for i:=2 to n do
if m[i]=false then
ok:=true;
end;
end;
procedure tipar;
var i:longint;
    f:text;
begin
assign(f,'dijkstra.out'); rewrite(f);
for i:=2 to n do
write(f,d[i],' ');
close(f);
end;
begin
citire;
afisare;
dijkstra;
tipar;
readln
end.