Cod sursa(job #558118)

Utilizator lakat_tLakatos Tamas lakat_t Data 17 martie 2011 09:01:42
Problema Algoritmul lui Dijkstra Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.52 kb
type
 lista=^elem;
 elem=record
  b,c:longint;
  kov:lista;
 end;
var
 f:text;
 multi:array[1..50000] of lista;
 map:array[1..5000,1..5000] of integer;
 i,j,n,m,a,b,c:longint;
 latott:array[1..50000]of boolean;
 tav:array[1..50000] of longint;
 honnan:array[1..50000] of longint;
 p:lista;

procedure betesz(var q:lista; b,c:longint);
var
 p:lista;
begin
 new(p);
 p^.b:=b;
 p^.c:=c;
 p^.kov:=q;
 q:=p;
end;

function min:longint;
var
 i,mm,t:longint;
begin
 mm:=maxlongint;
 t:=-1;
 for i:=1 to n do
  if not latott[i] and (mm>tav[i])
   then begin
         mm:=tav[i];
         t:=i;
        end;
 min:=t;
end;

begin
 assign(f, 'dijkstra.in');
 reset(f);
 readln(f,n,m);
 for i:=1 to m do
  begin
   readln(f, a,b,c);
   writeln(a,' ',b,' ',c);
   map[a,b]:=c;
   betesz(multi[a],b,c);
  end;
 close(f);
 for i:=1 to n do
  begin
   for j:=1 to n do
    write(map[i,j],' ');
   writeln;
  end;
 for i:=1 to n do
  begin
   latott[i]:=false;
   tav[i]:=maxlongint;
  end;
 latott[1]:=true;
 tav[1]:=0;
 honnan[1]:=-1;
 i:=1;
 while i<>-1 do
  begin
   latott[i]:=true;
   p:=multi[i];
   while p<>nil do
    begin
     if not latott[p^.b] and (tav[i]+p^.c<tav[p^.b])
      then begin
       tav[p^.b]:=tav[i]+p^.c;
       honnan[p^.b]:=i;
      end;
     p:=p^.kov;
    end;
   i:=min;
  end;
 assign(f, 'dijkstra.out');
 rewrite(f);
 for i:=2 to n do
  if tav[i]=maxlongint then write(f, 0,' ')
                       else write(f, tav[i],' ');
 close(f);
end.