kmenores.pas

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

Encontrar los $k$ enteros menores en un arreglo de longitud
$n$. Se hace o bien b\'usqueda del minimo $k$ veces o
bien clasificaci\'on r\'apida (quicksort), seg\'un sea 
$k$ con respecto a $log(n)$.
keywords: clasificacion

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: kmenores.pas 2003/06/30 16:19 rodrigop Exp jdelia  $ }
program k_menores;
  uses u_listai ;
const
  n = 50;
type
  tarreglo = array [1..n] of integer ;
  lista    = listai ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure INICIA (var a : tarreglo);
var
  i: integer;
begin
  writeln ;
  randomize;
  for i := 1 to (n) do  a [i] := 1 + random (n)
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure ESCRIBA (var a: tarreglo; n: integer; s: string) ;
var
  i : integer;
begin
  writeln ;
  writeln (s) ;
  for i := 1 to (n) do write (A [i], ' ') ;
  writeln
end ;
	   
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure SWAP (var x, y: integer);
var
  t: integer;
begin
  t := x ; x := y ; y := t
end ;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure QUICKSORT (var a: tarreglo; left, right: integer);
var
  p : integer;
  function PARTICION: integer;  {notar funcion anidada}
  var
    pivot : integer;
    l, r  : integer;
  begin    
    pivot := a [right];
    l := left ;
    r := right - 1;
    repeat
      while (a [l] <  pivot)             do l := l + 1;
      while (a [r] >= pivot) and (l < r) do r := r - 1;
      SWAP  (a [l] , a [r])
    until (l >= r);
    SWAP (a [l], a [r]);
    SWAP (a [l], a [right]);
    PARTICION := l
  end ; { PARTICION }
begin { QUICKSORT }
  if ( left < right ) then begin
    p := PARTICION;
    QUICKSORT (a, left, p-1);
    QUICKSORT (a, p+1, right)
  end {if}
end ; { QUICKSORT }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure KMENORES (var a: tarreglo; k: integer);
var
   j	   : integer;
   min, r  : tipo_elemento;
   L1, L2  : lista;
   q, qmin : posicion;
   zlog	   : real ;
   b       : boolean ;
begin
   zlog := ln (n) / ln (2) ;
   b    := ( k < zlog ) ;
   writeln ;
   writeln ('longitud arreglo    ; n = ', n);
   writeln ('menores a buscar    ; k = ', k);
   writeln ('                 ln (n) = ', zlog :5:5);
   writeln ('             k < ln (n) = ', b );
   readln ;
   if  (k < zlog) then begin
      writeln ('entonces busca el menor, k-veces en la lista');      
      writeln ;
      L1.ANULA ; 
      L2.ANULA ;
      for  j := 1 to (n) do L1.INSERTA ( a [j], L1.PRIMERO ) ;

      for  j := 1 to (k) do begin
	 q   := L1.PRIMERO ;
	 min := L1.RECUPERA (q);
	 while ( q <> L1.FIN ) do begin
	    r := L1.RECUPERA (q);
	    if (r < min) then begin
	       min  := r;
	       qmin := q
	    end ; {if}
	    q := L1.SIGUIENTE (q);
	 end; {while}
	 L1.SUPRIME (qmin);
	 L2.INSERTA (min, L2.FIN);
      end ; {j}
      L2.IMPRIME ('listado de los k menores: '); end
   else begin
      writeln ('entonces QUICKSORT e imprime los k menores' );
      writeln ('que estan en las k-primeras posiciones');
      QUICKSORT (a, 1, n);
      ESCRIBA (a, k, 'listado de los k menores:');
   end  ; {if}
   writeln
end ;
var
  a : tarreglo ;
begin
  INICIA (a) ;
  KMENORES (a, 12);
  KMENORES (a,  5);
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}