kmenores.pas

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

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

FIN DE DESCRIPCION }
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
{ $Id: kmenores.pas 2002/06/11 22:19 rodrigop Exp rodrigop$ }

{ Aqui se uso la funcion ln ya que en pascal no existe log
en base dos, pero esta es la que habria que utilizar para
evaluar la relacion k <=> log_2 (n) }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
program k_menores;

uses u_lispif;

const
   n = 100;
   k = 3;
var  
   A	   : array [1..n] of integer;
   i, j	   : integer;
   L, L1   : lispif;
   min, r  : tipo_elemento;
   q, qmin : posicion;
   zlog	   : real ;
	   
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure SWAP (var a : integer; var b : integer);
var
   t : integer;
begin
   t := a;
   a := b;
   b := t
end;

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
procedure QUICKSORT (left, right : integer);
var
   p	  : integer;
   {notar : nested function}   
   function PARTITION: integer;
   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]);
      PARTITION := l
   end; { PARTITION }
begin { QUICKSORT }
   if ( left < right ) then begin
      p := PARTITION;
      QUICKSORT ( left, p - 1);
      QUICKSORT (p + 1, right)
   end {if}
end; { QUICKSORT }

{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}
begin
   writeln ;
   randomize;
   for i:=1 to n do  A [i] := random (200);
   zlog := ln (n);
   if ( k < zlog ) then
   begin
      L.ANULA;
      L1.ANULA;
      for j := 1 to n do L.INSERTA (A [j], L.PRIMERO);
      L.IMPRIME ('listado del arreglo: ');
      writeln ;
      writeln ('como            k = ', k);
      writeln ('es menor a ln (n) = ', zlog:5:5);
      writeln ('entonces busca el menor k veces en la lista');      
      writeln ;
      for j:=1 to k do begin
	 q   := L.PRIMERO;
	 min := L.RECUPERA(q);
	 while (q <> L.FIN) do begin
	    r := L.RECUPERA (q);
	    if (r < min) then begin
	       min := r;
	       qmin:=q;
	    end; {if}
	    q := L.SIGUIENTE (q);
	 end; {while}
	 L.SUPRIME (qmin);
	 L1.INSERTA (min, L1.FIN);
      end; {j}
      L1.IMPRIME ('listado de los k menores: ');
   end {then}
   else begin
      writeln ('listado del arreglo: ');
      for i := 1 to n do write (A [i] : 4);
      writeln;
      writeln ('como    ln (n) = ', zlog:5:5);
      writeln ('es menor que k = ', k);
      writeln ('hace quicksort e imprime los k menores' );
      writeln ('que estan en las k-primeras posiciones');
      writeln ('del arreglo ordenado ');
      QUICKSORT (1,n);
      writeln ('listado de los k = ', k,' menores:');
      for i := 1 to k do writeln (A [i]:1);
   end; {if}
   writeln ;
end.
{-----+-----+-----+-----+-----+-----+-----+-----+-----+-----}