ralea.pas

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

  Dada una lista, retornar sus elementos ordenados en
  forma pseudo-aleatoria. 
  keywords: lista
  FIN DE DESCRIPCION }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: ralea.pas 2002/04/05 16:45 jdelia  Exp jdelia       $}

program ralea ;

const
  nmax = 10 ;

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 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}
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
  L : lista;
  i : integer;
begin
   ANULA (L);
   randomize;
   for i := 1 to nmax do begin
      INSERTA (i, FIN (L), L);
   end ; {for}
   IMPRIME (L);
   ORDENA_ALEATORIO (L);
   IMPRIME (L);
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}