Cod sursa(job #147485)

Utilizator eugen.nodeaEugen Nodea eugen.nodea Data 2 martie 2008 22:59:08
Problema Algoritmul lui Dijkstra Scor 10
Compilator fpc Status done
Runda Arhiva educationala Marime 2.53 kb
Const nmax=50000;
      inf=Maxint;
Type lista=^elem;
     elem=Record
                v:longint;
                c:real;
                urm:lista;
          end;
    mat=Array[1..nmax] Of lista;
Var
	C:mat;
	P:Array[1..nmax] Of byte;
	D:Array[1..nmax] Of real;
	S:Array[1..nmax] Of 0..1;
	i,j,n,m,x,y:longint;
	f:text;
	min,ct:real;
	ok:boolean;
        q:lista;
Procedure drum(k:longint);
begin
	If k<>0 then begin
			   drum(p[k]);
			   write(k,' ');
		       end;
end;
{construirea listelor de adiacenta prin adaugare la inceput}
Procedure adaug(x,y:longint;ct:real);
var p,q:lista;
begin
     If C[x]=nil then begin
                           new(p);
                           p^.v:=y;
                           p^.c:=ct;
                           p^.urm:=Nil;
                           C[x]:=p;
                      end
                  else begin
                           {adaug la inceput}
                           p:=C[x];
                           new(q);
                           q^.v:=y;
                           q^.c:=ct;
                           q^.urm:=p;
                           C[x]:=q;
                       end;
end;
BEGIN
  {citirea matricei costurilor}
  Assign(f,'dijkstra.in'); Reset(f);
  Readln(f,n,m);
  For i:=1 to n do
       C[i]:=Nil;
  {citirea muchiilor grafului si a costului asociat}
  For i:=1 to m do
      begin
	Readln(f,x,y,ct);
      adaug(x,y,ct);
      end;
  Close(f);
  {initializari}
  For i:=1 to n do
      begin
      D[i]:=inf;
      S[i]:=0;
      end;
  {x-varful de plecare}
  x:=1;
  {initializare drum care are ca varf de start pe x}
  q:=C[x];
  While q<>Nil do
       begin
        i:=q^.v;
	  D[i]:=q^.c;
	  p[i]:=x;
        q:=q^.urm;
       end;
  S[x]:=1; P[x]:=0;
  Repeat
        Ok:=False;
        min:=inf;
	  For i:=1 to n do
	    If (S[i]=0) and (D[i]< min) then
		begin
		   	min:=D[i];
		   	y:=i;
			Ok:=True;
		end;
	If ok then begin
		   S[y]:=1;
               q:=C[y];
                {relaxarea}
               While q<>Nil do begin
                   i:=q^.v;
                   If (S[i]=0)and(D[i]>D[y]+q^.c) then
					     begin
			  			D[i]:=D[y]+q^.c;
			  			p[i]:=y;
					     end;
                        q:=q^.urm;
                               end;
		      end;
  Until not ok;
  {afisarea drumurilor}
  Assign(f,'dijkstra.out'); Rewrite(f);
  For i:=1 to n do
	If i<>x then
	   If D[i]<>inf then
		begin
			Drum(i);
			Write(f,d[i]:0:0,' ');
		end;
  close(f);
END.