jose_lpi.pas

{ ppc386 -va -vh *.pas }
{ COMIENZO DE DESCRIPCION
  Resoluci\'on del problema de Josephus mediante TAD-LISTA 
  de enteros por punteros y con celdas de encabezamiento.
  FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{$Id: jose_lpi.pas v1.2 2002/04/04 17:40 mstorti Exp jdelia$}
program josephus_lpi ;
uses u_listpi ;
type
  lista = listpi;
const
  long = 7 ; {cantidad de soldados}
  n    = 4 ; {salto en el juego}

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function SIGUIENTE_CIRCULAR (var L: lista ;
                                 p: posicion): posicion;
var 
  q : posicion;
begin
  q := L.SIGUIENTE (p) ;  
  if  ( q = L.FIN ) then  q := L.PRIMERO;
  SIGUIENTE_CIRCULAR := q ;	
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure SUPRIME_CIRCULAR (var L: lista ;
                            var p: posicion);
begin
  L.SUPRIME (p);
  if  (p = L.FIN) then p := L.PRIMERO ;
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
function AVANZAR (var L: lista ; 
                      p: posicion ; 
                      n: integer ): posicion ;
var 
  k : integer;   { avanza (n - 1) posiciones }
begin
  for  k := 1 to (n - 1) do p := SIGUIENTE_CIRCULAR (L,p);
  AVANZAR := p ;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure IMPRIME_MARCA (L: lista; p: posicion);
var
  q : posicion;
begin
  q := L.PRIMERO;
  while (q <> L.FIN) do begin
    if (q <> p) then
       write (L.RECUPERA (q),' ')
    else begin
       write ('[', L.RECUPERA (q),'] ');
    end ; {if}
    q := L.SIGUIENTE (q);
  end ; {while}
  writeln ;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure JOSEPHUS (L: lista; n: integer);
var
  p : posicion ;
begin
  p := L.PRIMERO ;
  while ( SIGUIENTE_CIRCULAR (L,p) <> p) do begin
    writeln ('Avanza...');
    p := AVANZAR  (L, p, n);
    IMPRIME_MARCA (L, p);
    writeln ('Suprime...');
    SUPRIME_CIRCULAR (L, p);
    IMPRIME_MARCA (L,p);
  end ; {while}
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
  L : lista ;
  k : integer ;
begin 
  L.ANULA;
  for k := 1 to (long)  do L.INSERTA (k, L.FIN);
  L.IMPRIME ('lista inicial');
  writeln ('salto pre-elegido ; n = ', n);
  JOSEPHUS (L, n);
end . 

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ ejemplo lista inicial: 1 2 3 4 5 6 7 
  salto pre-elegido ; n = 4
  Avanza...
  1 2 3 [4] 5 6 7 
  Suprime...
  1 2 3 [5] 6 7 
  Avanza...
  [1] 2 3 5 6 7 
  Suprime...
  [2] 3 5 6 7 
  Avanza...
  2 3 5 [6] 7 
  Suprime...
  2 3 5 [7] 
  Avanza...
  2 3 [5] 7 
  Suprime...
  2 3 [7] 
  Avanza...
  2 3 [7] 
  Suprime...
  [2] 3 
  Avanza...
  2 [3] 
  Suprime...
  [2] 
}