Cod sursa(job #929067)

Utilizator Dddarius95Darius-Florentin Neatu Dddarius95 Data 26 martie 2013 20:24:02
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.74 kb
//Dijkstra complet lungimi+drumuri
//un singur varf de plecare -> start ; drumuri catre celelalte n-1 noduri
//O(n^2)
//40p infoarena
{$Q-}
program dijkkk;
type vect=array[1..5000]of longint;
     mat=array[1..5000,1..5000]of longint;
const infinit=maxint;
var d,pre,m:vect;c:mat;
    n,muchii,start:longint;
    f,g:text;
    intrare,iesire:array[1..300000] of char;

procedure initializare;
var i,j,x,y,cost:longint;
begin
readln(f,n,muchii);start:=1;
for i:=1 to n do
 for j:=1 to n do begin c[i,j]:=infinit; c[j,i]:=infinit;end;
for i:=1 to muchii do begin
                    readln(f,x,y,cost);
                    c[x,y]:=cost;
                    end;
for i:=1 to n do begin d[i]:=c[start,i]; pre[i]:=start;end;
m[start]:=1;pre[start]:=0;
end;

procedure asfalteaza;
var i,j,dmin,vfmin:longint;
begin
for j:=1 to n do
   begin
   dmin:=infinit;
   for i:=1 to n do
     if (m[i]=0)and(dmin>d[i]) then begin
                                    dmin:=d[i];
                                    vfmin:=i;
                                    end;
   m[vfmin]:=1;
   for i:=1 to n do
    if (m[i]=0)and(d[i]>dmin+c[vfmin,i]) then
                                             begin
                                             pre[i]:=vfmin;
                                             d[i]:=dmin+c[vfmin,i];
                                             end;
   end;
end;

procedure afiseaza;
var i,j,lg:longint;
    dr:vect;
begin
for i:=1 to n do
if d[i]<>maxint then write(g,d[i],' ')
                else write(g,'0 ');
end;

begin
assign(f,'dijkstra.in');reset(f);   settextbuf(f,intrare);
assign(g,'dijkstra.out');rewrite(g);settextbuf(g,iesire);
initializare;
asfalteaza;
afiseaza;
close(f);close(g);
end.