menor.pas

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

  Dada una lista de ciudades y una funci\'on DISTANCIA que
  retorna la distancia entre dos ciudades dadas, busca el
  camino de menor recorrido, utilizando un algoritmo
  heur\ia istico. keywords: algoritmos

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id:  menor.pas  2002/04/05 14:20 mstorti Exp jdelia     $}

program menor_recorrido_test ;

const
   nnodos  = 20;
   chunk   = 10000;
   max_dis =  100 ;
type
  tipo_elemento = integer;
  tipo_celda = record
    elemento : tipo_elemento;
    sig      : ^tipo_celda;
  end;	       
  lista	= ^tipo_celda;
  posicion = ^tipo_celda;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ IMPLEMENTACION DE LISTAS }

procedure INSERTA(    x	: tipo_elemento;
		      p	: posicion;
		  var L	: lista);
var 
  temp	 : posicion;
  nuevo : ^tipo_celda;
begin
  temp := p^.sig;
  new (nuevo);
  p^.sig := nuevo;
  nuevo^.elemento := x;
  nuevo^.sig := temp;
end; {INSERTA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function ANULA (var L : lista) : posicion;
begin
  new (L);
  L^.sig := nil;
  ANULA  := L;
end; {ANULA}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure IMPRIME (L : lista);
var
  p : posicion;
  q  : ^tipo_celda;
begin
  p := L;
  writeln ('Lista: ');
  q := p^.sig;
  while q <> nil do begin
    writeln (q^.elemento);
    q := q^.sig;
  end; {while}
  writeln ('Fin de la lista');
end; {IMPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function PRIMERO (L : lista) : posicion;
begin
  PRIMERO := L;
end;{PRIMERO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure SUPRIME (    p : posicion;
		   var L : lista);
var
  tmp : posicion;
begin 
  tmp := p^.sig;
  p^.sig := tmp^.sig;
end; {SUPRIME}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function FIN (L :  lista) : posicion;
var
  q : posicion;
begin
  q := L;
  while (q^.sig <> nil) do q := q^.sig;
  FIN := q;
end; { FIN }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function RECUPERA (p : posicion; L: lista): tipo_elemento;
var
  tmp : posicion;
begin 
  tmp := p^.sig;
  RECUPERA := tmp^.elemento;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function SIGUIENTE (p : posicion; L: lista): posicion;
begin
  SIGUIENTE := p^.sig;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure COPIA (L1 : lista; var L2:lista);
var
  p : posicion;
begin
  ANULA (L2);
  p := PRIMERO (L1);
  while (p <> FIN (L1) ) do begin
    INSERTA ( RECUPERA (p, L1), FIN (L2), L2);
    p := SIGUIENTE (p,L1);
  end; {while}
end; {COPIA}

{-----+-----+-----+ EJERCICIO +-----+-----+-----+-----+-----}
function DISTANCIA (a, b: integer): real;
var
  bb : tipo_elemento;
begin	     
  DISTANCIA := max_dis ;
  bb := b + 1;
  if (bb > nnodos) then  bb := 1;
  if (a = bb) then  DISTANCIA := 1;
  bb := b - 1;
  if (bb = 0) then  bb := nnodos;
  if (a = bb) then  DISTANCIA := 1;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function MAS_CERCANO (no_visitado: lista;
                           ultima: tipo_elemento): posicion;
var
  q, qmin: posicion;
  c, cmin: tipo_elemento;
begin
  qmin := PRIMERO (no_visitado);
  q := SIGUIENTE (qmin, no_visitado);
  while ( q <> FIN (no_visitado) ) do begin
    c := RECUPERA (q,no_visitado);
    cmin := RECUPERA (qmin, no_visitado);
    if DISTANCIA (c,ultima) <
       DISTANCIA (cmin,ultima) then qmin := q;
    q := SIGUIENTE (q, no_visitado);
  end ; {while}
  MAS_CERCANO := qmin;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure MENOR_RECORRIDO (var   camino: lista;
                               ciudades: lista);
var
  p		    : posicion;
  c, ultima, primera : tipo_elemento;
  no_visitado	    : lista;
begin
 {Inicializa camino}
  ANULA (camino);

 {Copia 'ciudades' en 'no_visitado' }
  ANULA (no_visitado);
  p := PRIMERO (ciudades);
  while ( p <> FIN (ciudades) ) do begin
    c := RECUPERA (p, ciudades);
    INSERTA (c, FIN (no_visitado), no_visitado);
    p := SIGUIENTE (p, ciudades);
  end; {while}

  {Mueve primera ciudad en 'no_visitado' a 'camino'}
  p := PRIMERO (no_visitado);
  c := RECUPERA (p, no_visitado);
  INSERTA (c, PRIMERO (camino), camino);
  SUPRIME (p, no_visitado);

  ultima  := c;
  primera := c;

  while PRIMERO (no_visitado) <> FIN (no_visitado) do begin
    p := MAS_CERCANO (no_visitado, ultima);
    ultima := RECUPERA (p, no_visitado);
    INSERTA (ultima, FIN (camino), camino);
    SUPRIME (p,no_visitado);
  end; {while}

  {Inserta la primera al final para que el camino sea cerrado}
  INSERTA (primera, FIN (camino), camino);
end; { MENOR_RECORRIDO }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ORDENA_ALEATORIO (var L : lista);
var
  n, i, j, k: integer;
  p         : posicion;
  auxiliar  : lista;
  c         : tipo_elemento;
begin
 {Cuenta cuantos elementos hay en la lista}
 {y pasa todos los elementos a 'auxiliar', 'L' queda vacia}
  n := 0;
  p := PRIMERO (L);
  ANULA (auxiliar);
  while (p <> FIN (L) ) do begin
    INSERTA ( RECUPERA (p,L), FIN (auxiliar), auxiliar);
    SUPRIME (p,L);
    n := n + 1;
  end; {while}

 {Va tomando elementos al azar de 'auxiliar' y los pone en 'L'}
  for i := 1 to n do begin
    j := TRUNC (RANDOM * (n - i + 1)) + 1;
    p := PRIMERO (auxiliar);
    for k := 1 to (j - 1) do  p := SIGUIENTE (p, auxiliar);
    c := RECUPERA (p, auxiliar);
    SUPRIME (p, auxiliar);
    INSERTA (c, FIN (L),L);
   end ; {i}
end; {ORDENA_ALEATORIO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function CALCULA_RECORRIDO (camino: lista): real;
var
  dist	 : real;
  p   	 : posicion;
  c, cc : tipo_elemento;
begin	
  dist := 0;
  p := PRIMERO (camino);
  c := RECUPERA (p, camino);
  p := SIGUIENTE (p, camino);
  while (p <> FIN (camino) ) do begin
    cc   := RECUPERA (p,camino);
    dist := dist + DISTANCIA (c,cc);
    c    := cc ;
    p    := SIGUIENTE (p,camino);
  end ; {while}
  CALCULA_RECORRIDO := dist;
end; {CALCULA_RECORRIDO}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
  ciudades, camino, aleatorio : lista;
  i, k	  : integer;
  dmin, d : real;
  pri	  : tipo_elemento;
begin
   ANULA (ciudades);
   for i := 1 to nnodos do begin
      INSERTA (i, FIN (ciudades), ciudades);
   end ; {for}
   writeln ('Orden inicial de las ciudades');
   IMPRIME (ciudades);
   
   {Pone las ciudades en forma aleatoria en ciudades}
   ORDENA_ALEATORIO (ciudades);
   writeln ('Despues de desordenar');
   IMPRIME (ciudades);

   MENOR_RECORRIDO (camino,ciudades);
   writeln ('menor camino');
   IMPRIME (camino);

   writeln ('Distancia recorrida en el camino: ',
   CALCULA_RECORRIDO (camino));

   dmin := 1.0e6;
   k    := 0;
   while (true) do begin
     k := k + 1;
     if (k = chunk) then begin
       writeln (chunk,' ejecutados...');
       k := 2;
     end ; {if}
     COPIA (ciudades, aleatorio);
     ORDENA_ALEATORIO (aleatorio);
     pri := RECUPERA (PRIMERO (aleatorio), aleatorio);
     INSERTA ( pri, FIN (aleatorio), aleatorio);
     d := CALCULA_RECORRIDO (aleatorio);
     if (k = 1) or (d < dmin) then begin
       writeln('distancia mas corta:',d);
       IMPRIME (aleatorio);
       dmin := d;
     end; {if}
   end; {while}   
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}