ordenag.pas

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

[Tomado en el examen final del 5-Dic-2002]. 
Escribir un procedure ORDENAG (var L: lista; m:integer);
que dada una lista L va ordenando sus elementos de
a grupos de "m" elementos. Por ejemplo si m=5, entonces
ORDENAG ordena los primeros 5 elementos entre si, despu\'es
los siguientes 5 elementos, y asi siguiendo. Si la
longitud N de la lista no es un m\'ultiplo exacto de "m",
entonces los ultimos (N mod m) elementos tambi\'en
deben ser ordenados entre si. Por ejemplo, si
L=(10 1 15 7 2 19 15 16 11 15 9 13 3 7 6 12 1), 
entonces despu\'es de ORDENAG (L, 5) debemos tener
L=(1 2 7 10 15 11 15 15 16 19 3 6 7 9 13 1 12). 
keywords: lista

FIN DE DESCRIPCION

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $ Id: ordenag.pas  2002/12/02 16:30 mstorti Exp jdelia $ }

program ordenag_p;

uses u_listpi;

type
  lista = listpi;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{Esta version es in-place, un poco mas complicada de seguir}
procedure ORDENA_G1 (var L: lista; m: integer);
var
   p, q    : posicion;
   x, c, n : integer;
begin
   p := L.PRIMERO;
   while (p <> L.FIN) do begin
   { Ordena los m elementos a partir de "p" por          }
   { insercion. Es decir, para n=2 hasta m, vamos tomando}
   { el elemento en la posicion p+n-1 y lo insertamos en }
   { la secuencia que va desde p hasta p+n-2, en la      }
   { posicion que le corresponde                         }
     for n := 2 to m do begin
       q := p;
       c := 0;
     { Ubica la posicion p+n-1 }
       while (c < n-1) do begin
	 q := L.SIGUIENTE (q);
	 if (q = L.FIN) then exit;
	 c := c + 1;
       end; {while}
     { Toma el elemento de esa posicion y lo elimina }
       x := L.RECUPERA (q);
       L.SUPRIME (q);
     { Recorre la secuencia p a p+n-2 y lo inserta}
     { en su posicion correcta }
       q := p;
       c := 0;
       while (c < n-1) do begin
	 if (x <= L.RECUPERA (q) ) then break;
	 c := c + 1;
	 q := L.SIGUIENTE (q);
       end; {while}
       L.INSERTA (x,q);
     end; {for}
   { Avanza `p' `m' posiciones }
     for c:=1 to m do p := L.SIGUIENTE (p);
   end ; {while}
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ Esta version es mas simple pero usa dos listas auxiliares }
procedure ORDENA_G2 (var L: lista; m: integer);
var
   p, q	   : posicion;
   L1, L2  :  lista;
   x, c, n : integer;
begin
   L1.ANULA;
   L2.ANULA;
   while (L.PRIMERO <> L.FIN) do begin {Mueve m elem. a L1 }
     c := 0;
     while (c < m) do begin
       q := L.PRIMERO;
       if (q = L.FIN) then break;
       x := L.RECUPERA (q);
       L.SUPRIME (q);
       L1.INSERTA (x, L1.FIN);
       c := c + 1;
     end; {while}
   { Ordena los elementos en L1 moviendolos a L2          }
   { El seudocodigo seria:                                }
   { while L no esta vacia do                             }
   { saca el elemento mas pequenio de L1 y lo pone en L2  }
     while (L1.PRIMERO <> L1.FIN) do begin
       p := L1.PRIMERO;
       q := L1.SIGUIENTE (p);
       while (q <> L1.FIN) do begin
	 if (L1.RECUPERA (q) < L1.RECUPERA (p)) then p := q;
	 q := L.SIGUIENTE (q);
       end; {while}
       L2.INSERTA (L1.RECUPERA (p), L2.FIN);
       L1.SUPRIME (p);
     end; {while}
   end; {while}
 { Copia todos los elementos de L2 a L }
   p := L2.PRIMERO;
   while (p <> L2.FIN) do begin
     L.INSERTA (L2.RECUPERA (p), L.FIN);
     p := L2.SIGUIENTE (p);
   end; {while}
   L1.ANULA;
   L2.ANULA;
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
var
   L : lista;
   k : integer;
begin
   randomize ;
   L.ANULA;
   { Genera  un cierto numero aleatorio de elmentos }
   for k := 1 to (10 + random (10) ) do
     L.INSERTA (random (20), L.FIN );
   
   L.IMPRIME ('Antes de ordena_g: ');
   ORDENA_G2 (L,5);
   L.IMPRIME ('Despues de ordena_g(5): ');
   ORDENA_G2 (L,3);
   L.IMPRIME ('Despues de ordena_g(3): ');
   ORDENA_G2 (L,4);
   L.IMPRIME('Despues de ordena_g(4): ');
   ordena_g3 (L,7);
   L.IMPRIME ('Despues de ordena_g(7): ');
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}

Generated by GNU enscript 1.6.1.