viajant2.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION

Problema del viajante mediante un algoritmo \'avido,
versi\'on 2. keywords: algoritmos

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: viajant2.pas 2002/04/05 19:00 jdelia  Exp jdelia    $}

program viajante2;

const 
   N = 4 ;
     
var 
   A			    : array [1..N,1..N] of real;
   mark			    : array [1..N,1..N] of integer;
   cmin, cmax		    : real ;
   sig			    : array [1..N,1..2] of integer;
   sum_i, sum_j, imin, jmin : integer;
   i, j, k, l, p, q, pp	    : integer;
			    
label
   no_inserta, inserta;	
begin 
   cmax := 0;
   imin := 0 ;
   jmin := 0 ;
   for i:= 1 to N do begin
      sig [i,1] := 0;
      sig [i,2] := 0;
      for j := 1 to N do begin
	 A [i,j] := abs (i - j) + 1;
	 if A [i,j] > cmax then cmax := A [i,j];
	 mark [i,j] := 0;
      end; {j}
      mark [i,i] := 1;
   end ; {i}
   for pp := 1 to N do begin
      cmin := cmax;
      for i:= 1 to N do begin
	 for j:= 1 to N do begin
	    writeln ('eval arista i,j-> ',i,',',j);
	    if mark [i,j] = 1 then goto no_inserta;
	    writeln ('arista i, j no esta marcada');
	    writeln;
	    if A [i,j] > cmin then goto no_inserta;
	    writeln ('costo menor al min actual ');
	    writeln ('cmin=',cmin: 3:3, ' >= ', 'd(A[',i,',',j,'])=',A [i,j] :3:3);
	    sum_i := 0;
	    sum_j := 0;
	    for k := 1 to N do begin
	       sum_i := sum_i + mark [i,k];
	       sum_j := sum_j + mark [k,j];
	    end; {k}
	    if (sum_i > 2) or (sum_j > 2) then goto no_inserta;
	    writeln ('Ninguno de los nodos tiene grado <= 2');
	    p := i;
	    q := i;
	    writeln ('Verifica que no haya lazo');
	    for l:= 1 to (N + 3) do begin
	       if (p = j) then goto no_inserta;
	       if sig [p,1] = 0 then goto inserta;
	       if (l = 1) then
		  p := sig [p,1]
	       else begin
		  if (sig [p,1] <> q) then 
		     p := sig [p,1]
		  else begin
		     if (sig [p,2] = 0) then goto inserta;
		     p := sig [p,2];
		  end; {if}
	       end; {if}
	       writeln (q,' -> ',p);
	    end; {l}
	    inserta:
		    writeln ('prueba: ','imin=', imin,' jmin=', jmin, ' cmin=',cmin:3:3);
	    imin := i;
	    jmin := j;
	    cmin := A [i,j];
	    writeln('Nuevo cmin=A[i,j]=',cmin);
	    writeln;
	    no_inserta: ;
	 end; {j}
      end; {i}
      writeln ('inserta: ','imin=', imin,' jmin=', jmin, ' cmin=',cmin:3:3);
      mark [imin,jmin] := 1;
      mark [jmin,imin] := 1;
      if sig [imin,1] = 0 then
	 sig [imin,1] := jmin
      else if sig [imin,2]=0 then
	 sig [imin,2] := jmin
      else begin
	 writeln ('Tratando de insertar en un nodo con grado 2');
	 halt;
      end; {if}
      if sig [jmin,1] = 0 then
	 sig [jmin,1] := imin
      else if sig [jmin,2] = 0 then
	 sig [jmin,2] := imin
      else begin
	 writeln ('Tratando de insertar en un nodo con grado 2');
	 halt;
      end; {if}
   end ; {pp}
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}