Cod sursa(job #545576)

Utilizator FLORINSTELISTUOprea Valeriu-Florin FLORINSTELISTU Data 3 martie 2011 16:44:13
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 1.5 kb
type mat=array[1..1500,1..1500] of longint;
     vect=array[1..50000] of longint;
var a:mat;
    s,t,d:vect; f,g:text;
    r,n,i,j,min,poz:integer;

procedure drum(i:integer);
begin
    if t[i]<>0 then begin
          drum(t[i]);
          write(i:4);
        end
               else write(i:4);
end;
procedure citire(Var n:integer;var a:mat);
var x,i,y,c,m:integer;
begin
       readln(f,n,m);
     for i:=1 to n do
      for j:=i+1 to n do begin
       a[i,j]:=maxint;
       a[j,i]:=a[i,j];
        end;
     for i:=1 to m do begin
       readln(f,x,y,c);
       a[x,y]:=c;
     end;
end;
begin
    assign(f,'dijkstra.in');reset(F);
    assign(g,'dijkstra.out');rewrite(g);
     citire(n,a); r:=1;
    for i:=1 to n do begin
     s[i]:=0;
     t[i]:=0;
     a[i,i]:=0;
   end;
     s[r]:=1;
    for i:=1 to n do begin
      d[i]:=a[r,i];
      if i<>r then
        if d[i]<30000 then t[i]:=r;
   end;
      for i:=1 to n-1 do begin
     min:=30000;
       for j:=1 to n do
      if s[j]=0 then
        if d[j]<min then begin
              min:=d[j];
              poz:=j;
            end;
     s[poz]:=1;
     for j:=1 to n do
       if s[j]=0 then
         if d[j]>d[poz]+a[poz,j] then begin
                 d[j]:=d[poz]+a[poz,j];
                 t[j]:=poz;
              end;
  end;
           for i:=1 to n do
              if i<>r then  begin
     write({'Costul minim de la ',r,' la ',i,' este:',}g,d[i],' ');
      {drum(i);}
   end;
   close(f);close(g);
end.