program ordenacao;

const MAXTAM = 20;

type TipoChave  = integer;
     TipoItem   = record 
                    Chave: TipoChave;
                    { outros componentes }
                  end;
     TipoIndice = 0..MAXTAM;
     TipoVetor  = array [TipoIndice] of TipoItem;

var A: TipoVetor;
    B: TipoVetor;
    i: TipoIndice;
    n: TipoIndice;
    k: TipoIndice;

procedure SelecaoParcial (var A: TipoVetor; n, k: TipoIndice);
var i, j, Min: TipoIndice;
    x        : TipoItem;
begin
for i := 1 to k do
  begin
  Min := i;
  for j := i + 1 to n do if A[j].Chave < A[Min].Chave then Min := j;
  x := A[Min]; A[Min] := A[i]; A[i] := x;
  end;
end;

procedure InsercaoParcial (var A: TipoVetor; n, k: TipoIndice);
{-- Nao preserva o restante do vetor --}
var i, j: TipoIndice; x: TipoItem;
begin
for i := 2 to n do
  begin
  x := A[i];
  if i > k then j := k else j := i - 1;
  A[0] := x; { sentinela }
  while x.Chave < A[j].Chave do
    begin A[j + 1] := A[j]; j := j - 1; end;
  A[j+1] := x; 
  end;
end;

procedure InsercaoParcial2 (var A: TipoVetor; n, k: TipoIndice);
{-- Preserva o restante do vetor --}
var i, j: TipoIndice; x: TipoItem;
begin
for i := 2 to n do
  begin
  x := A[i];
  if i > k 
  then begin 
       j := k; 
       if x.Chave < A[k].Chave then A[i] := A[k]; 
       end
  else j := i - 1;
  A[0] := x; { sentinela }
  while x.Chave < A[j].Chave do
    begin
    if j < k then A[j + 1] := A[j];
    j := j - 1;
    end;
  if j < k then A[j+1] := x; 
  end;
end;

procedure QuickSortParcial (var A: TipoVetor; n, k: TipoIndice);

  procedure Particao (Esq, Dir: TipoIndice; var i, j: TipoIndice);
  var x, w: TipoItem;
  begin
    i := Esq; j := Dir;
    x := A[(i + j) div 2]; { obtem o pivo x }
    repeat
      while x.Chave > A[i].Chave do i := i + 1;
      while x.Chave < A[j].Chave do j := j - 1;
      if i <= j
      then begin
           w := A[i]; A[i] := A[j]; A[j] := w;
           i := i + 1; j := j - 1;
           end;
    until i > j;
  end; { Particao }

  procedure Ordena (Esq, Dir, k: TipoIndice);
  var i, j: TipoIndice;
  begin
    Particao (Esq, Dir, i, j);
    if (j-Esq) >= (k-1)
    then begin if Esq < j then Ordena (Esq, j, k) end
    else begin
         if Esq < j then Ordena (Esq, j, k);
         if i < Dir then Ordena (i, Dir, k);
         end;
  end; { Ordena }
begin
  Ordena (1, n, k);
end; { QuicksortParcial }

procedure HeapsortParcial (var A: TipoVetor; n, k: TipoIndice);
{-- Coloca menor em A[n], segundo menor em A[n-1],...,k-esimo em A[n-k] --}
var Esq, Dir: TipoIndice;
    x       : TipoItem;
    Aux     : integer;

  procedure Refaz (Esq, Dir: TipoIndice; var A: TipoVetor);
  label 999;
  var i: TipoIndice;
      j: integer;
      x: TipoItem;
  begin
    i := Esq; j := 2 * i;
    x := A[i];
    while j <= Dir do
      begin
      if j < Dir
      then if A[j].Chave > A[j + 1].Chave then j := j + 1;
      if x.Chave <= A[j].Chave then goto 999;
      A[i] := A[j];
      i := j; j := 2 * i;
      end;
    999: A[i] := x;
  end; { Refaz }
  
  procedure Constroi (var A: TipoVetor; n: TipoIndice);
  var Esq: TipoIndice;
  begin
    Esq := n div 2 + 1;
    while Esq > 1 do
      begin
      Esq := Esq - 1;
      Refaz (Esq, n, A);
      end;
  end; { Constroi }

begin
  Constroi(A, n);  { constroi o heap }
  Aux := 0;  Esq := 1;  Dir := n;
  while Aux < k do  { ordena o vetor }
    begin
    x := A[1];  A[1] := A[n - Aux];  A[n - Aux] := x;
    Dir := Dir - 1;  Aux := Aux + 1;
    Refaz (Esq, Dir, A);
    end;
end; { HeapsortParcial }

procedure DavisortParcial (var A: TipoVetor; n, k: TipoIndice);
var candidatos, pivo: TipoIndice;
    i: TipoIndice;
    x: TipoItem;
label 999;

  procedure Particao (Esq, Dir: TipoIndice; var i, j: TipoIndice);
  var x, w: TipoItem;
  begin
    i := Esq; j := Dir;
    x := A[(i + j) div 2]; { obtem o pivo x }
    repeat
      while x.Chave > A[i].Chave do i := i + 1;
      while x.Chave < A[j].Chave do j := j - 1;
      if i <= j
      then begin
           w := A[i]; A[i] := A[j]; A[j] := w;
           i := i + 1; j := j - 1;
           end;
    until i > j;
  end;

  procedure EncontraPivo(Esq, Dir, k: TipoIndice);
  var i, j: TipoIndice;
  begin
    particao(Esq, Dir, i, j);
    if j >= k then EncontraPivo(Esq, j, k); 
    if i <= k then EncontraPivo(i, Dir, k);
  end;

  procedure Ordena (Esq, Dir, k: TipoIndice);
  var i, j: TipoIndice;
  begin
    particao (Esq, Dir, i, j);
    if (j-Esq) >= (k-1)
    then begin if Esq < j then Ordena (Esq, j, k) end
    else begin
         if Esq < j then Ordena (Esq, j, k);
         if i < Dir then Ordena (i, Dir, k);
         end;
  end; { Ordena }

begin
  if 2*k >= n then begin Ordena(1, n, k); goto 999; end;
  EncontraPivo(1, k, k);
  candidatos := k;
  pivo := A[k].Chave;
  for i:= k + 1 to n do 
    begin
    if A[i].Chave <= pivo 
    then begin
         candidatos := candidatos + 1;
         x := A[candidatos];
         A[candidatos] := A[i];
         A[i] := x;
         end;
    if candidatos = 2*k 
    then begin
         EncontraPivo(1, candidatos, k);
         pivo := A[k].Chave;
         candidatos := k + 1;
         end;
    end;
  Ordena (1, candidatos, k);
  999:
end; { Davisort }

procedure Imprime (V: TipoVetor; n: TipoIndice);
begin
  for i := 1 to n do write (V[i].Chave,' ');
  writeln;
end;

procedure Copia (Fonte: TipoVetor; var Destino: TipoVetor; n: TipoIndice);
begin
  for i := 1 to n do Destino[i] := Fonte[i];
end;

procedure Testa (var V: TipoVetor; n, k: TipoIndice);
begin
  for i := 2 to k do
    begin
    if V[i].Chave < V[i-1].Chave
    then begin
         write ('ERRO: ');
         Imprime (V,n);
  {       halt;
         return;
  }
       end;
    end;
  write ('OK: ');
  Imprime (V,n);
end;

begin
  n := 10; {Tamanho do arranjo a ser ordenado}
  randomize;
  for i := 1 to n do
    begin
    A[i].Chave := 1 + random (n);
    B[i].Chave := A[i].Chave;
    end;
  write ('Desordenado: ');
  Imprime (A,n);

  write ('SelecaoParcial com k = '); readln(k);
  SelecaoParcial (B, n, k);
  Testa (B, n, k);
  Copia (A,B,n);

  write ('InsercaoParcial (sem preservar restante do vetor) com k = '); readln(k);
  InsercaoParcial (B, n, k);
  Testa (B, n, k);
  Copia (A,B,n);

  write ('InsercaoParcial (preserva restante do vetor) com k = '); readln(k);
  InsercaoParcial2 (B, n, k);
  Testa (B, n, k);
  Copia (A,B,n);

  write ('QuicksortParcial com k = '); readln(k);
  QuicksortParcial (B, n, k);
  Testa (B, n, k);
  Copia (A,B,n);

  write ('Heapsort com k = '); readln(k);
  HeapsortParcial (B,n,k);
  Testa (B,n,k);
  Copia (A,B,n);

  write ('Davisort  '); readln(k);
  DavisortParcial (B,n,k);
  Testa (B,n,k);
  Copia (A,B,n);

end.