Cod sursa(job #334296)

Utilizator sapiensCernov Vladimir sapiens Data 25 iulie 2009 22:59:09
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.6 kb
Program Dijkstra;
 type arc = record
              u,v:1..50000;
              w:0..1000;
            end;
 var f,g:text; a:array[1..250000]of arc;
     b:array[1..50000]of longint;
     c:array[1..50000]of boolean;
     m,n:longint;
 procedure initiere;
  var x:longint;
  begin
   assign (f,'dijkstra.in'); reset (f);
   assign (g,'dijkstra.out'); rewrite (g);
   readln (f,n,m);
   for x:=1 to m do readln (f,a[x].u,a[x].v,a[x].w);
  end;
 procedure incheiere;
  var x:longint;
  begin
   for x:=1 to n do if b[x]<>maxlongint then write (g,b[x],' ') else write (g,'0 ');
   close (f); close (g);
  end;
 procedure exista (x,y:longint; var z:longint);
  var t:longint;
  begin
   z:=-1;
   for t:=1 to m do
     if (a[t].u=x) and (a[t].v=y) then begin
       z:=a[t].w;
       exit;
     end;
  end;
 function min (x,y:longint):longint;
  begin
   if x<y then min:=x else min:=y;
  end;
 function getcurent:longint;
  var x,y:longint;
  begin
   y:=maxlongint;
   for x:=1 to n do
     if c[x] then continue else
       if b[x]<y then begin
         getcurent:=x;
         y:=b[x];
       end;
  end;
 procedure calcul;
  var x,y,z:longint; p:boolean;
  begin
   for x:=2 to n do b[x]:=maxlongint;
   b[1]:=0;
   x:=1;
   p:=true;
   while p do begin
     p:=false;
     c[x]:=true;
     for y:=1 to n do
       if not c[y] then begin
         exista (x,y,z);
         if (z<>-1) then begin
           p:=true;
           b[y]:=min (b[y],b[x]+z);
         end;
       end;
     if p then x:=getcurent;
   end;
  end;
 begin
  initiere;
  calcul;
  incheiere;
 end.