Cod sursa(job #532725)

Utilizator chimistuFMI Stirb Andrei chimistu Data 12 februarie 2011 11:43:59
Problema Algoritmul lui Dijkstra Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
const infinit=maxint div 2;
var c:array[1..20,1..20] of integer;
    d,anterior:array[1..20] of integer;
    selectat:array[1..20] of boolean;
    n,m,i0,i,j,k,x,y,cost:integer;
    g:boolean;
    f,q:text;
procedure min(var k:integer);
var i,m:integer;
begin
m:=infinit*2;
for i:=1 to n do
   if (selectat[i]=false) and (d[i]<m) then
      begin
      m:=d[i];k:=i;
      end;
end;
procedure drum(i:integer);
begin
if i<>0 then
   begin
   drum(anterior[i]);
   write(i,' ');
   end
end;
begin
assign (f,'dijkstra.in');assign (q,'dijkstra.out');
reset (f);rewrite (q);
read(f,n);
for i:=1 to n do
    for j:=1 to n do
       if i=j then
        c[i,j]:=0
       else c[i,j]:=infinit;
read(f,m);
for i:=1 to m do
        begin
        readln(f,x,y,cost);
        c[x,y]:=cost;
        end;
i0:=1;
for i:=1 to n do
    begin
    selectat[i]:=false;
    d[i]:=c[i0,i];
    if d[i]<infinit then anterior[i]:=i0
                    else anterior[i]:=0;
    end;
selectat[i0]:=true;
anterior[i0]:=0;
d[i0]:=0;
g:=true;
x:=0;
repeat
    min(k); x:=x+1;
    if (d[k]=infinit) or (x=n) then g:=false
    else
    begin
    selectat[k]:=true;
    for i:=1 to n do
        if (not selectat[i]) and (d[k]+c[k,i]<d[i]) then
           begin
           d[i]:=d[k]+c[k,i];
           anterior[i]:=k;
           end;
    end;
until not g;
for i:=1 to n do
  if i<>i0 then
    if d[i]<infinit then
    write(q,d[i],' ')
    else
         write(q,0,' ');
writeln;
close (q);
end.