Cod sursa(job #334708)

Utilizator sapiensCernov Vladimir sapiens Data 27 iulie 2009 18:18:01
Problema Algoritmul lui Dijkstra Scor 0
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
Program dijkstra;
 type rind = array[1..50000]of ^integer;
 var f,g:text; a:array[1..50000]of ^rind;
     b:array[1..50001]of boolean;
     c:array[1..50000]of longint;
     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 begin
     read (f,y,z);
     if a[y]=nil then begin
       new (a[y]);
       new (a[y]^[z]);
     end else if a[y]^[z] = nil then new (a[y]^[z]);
     readln (f,a[y]^[z]^);
   end;
  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;
 function vecin (x,y:longint):boolean;
  begin
   if a[x]<>nil then if a[x]^[y]<>nil then vecin:=true else vecin:=false;
  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 vecin (x,y) and not b[y] then
         c[y]:=minim (c[y],c[x]+a[x]^[y]^);
     x:=getnext;
   end;
  end;
 begin
  initiere;
  calcul;
  incheiere;
 end.