Cod sursa(job #334457)

Utilizator sapiensCernov Vladimir sapiens Data 26 iulie 2009 20:31:25
Problema Algoritmul lui Dijkstra Scor 20
Compilator fpc Status done
Runda Arhiva educationala Marime 1.18 kb
Program dijkstra;
 var f,g:text; a:array[1..21504,1..21504]of 0..1000;
     b:array[1..50001]of boolean;
     c:array[1..50000]of 0..50000000;
     n,m:longint;
 procedure initiere;
  var x,y,z:longint;
  begin
   assign (f,'dijkstra.in'); reset (f);
   assign (g,'dijkstra.out'); rewrite (g);
   readln (f,n,m);
   for x:=1 to m do read (f,y,z,a[y,z]);
  end;
 procedure incheiere;
  var x:longint;
  begin
   for x:=2 to n do if c[x]<50000000 then write (g,c[x],' ') else write (g,'0 ');
   close (f); close (g);
  end;
 function minim (x,y:longint):longint;
  begin
   if x<y then exit (x) else exit (y);
  end;
 function getnext:longint;
  var x,y:longint;
  begin
   y:=50000000;
   getnext:=n+1;
   for x:=1 to n do
     if (c[x]<y) and not b[x] then begin
       getnext:=x;
       y:=c[x];
     end;
  end;
 procedure calcul;
  var x,y:longint;
  begin
   for x:=2 to n+1 do c[x]:=50000000;
   x:=1;
   c[x]:=0;
   while c[x]<50000000 do begin
     b[x]:=true;
     for y:=1 to n do
       if (a[x,y]<>0) and not b[y] then
         c[y]:=minim (c[y],c[x]+a[x,y]);
     x:=getnext;
   end;
  end;
 begin
  initiere;
  calcul;
  incheiere;
 end.