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;

procedure Selecao (var A: TipoVetor; n: TipoIndice);
var i, j, Min: TipoIndice;
    x        : TipoItem;
begin
for i := 1 to n - 1 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 Insercao (var A: TipoVetor; n: TipoIndice);
var i, j: TipoIndice;
    x   : TipoItem;
begin
for i := 2 to n do
  begin
  x := A[i];
  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 Shellsort (var A: TipoVetor; n: TipoIndice);
label 999;
var i, j, h: integer;
    x      : TipoItem;
begin
  h := 1;
  repeat h := 3 * h + 1 until h >= n;
  repeat
    h := h div 3;
    for i := h + 1 to n do
      begin
      x := A[i];
      j := i;
      while A[j - h].Chave > x.Chave do
        begin
        A[j] := A[j - h];
        j := j - h;
        if j <= h then goto 999;
        end;
      999 : A[j] := x;
      end;
  until h = 1;
end;

procedure QuickSort (var A: TipoVetor; n: 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;

  procedure Ordena (Esq, Dir: TipoIndice);
  var i, j: TipoIndice;
  begin
    particao (Esq, Dir, i, j);
    if Esq < j then Ordena (Esq, j);
    if i < Dir then Ordena (i, Dir);
  end;
begin
  Ordena (1, n);
end;

procedure Heapsort (var A: TipoVetor; n: TipoIndice);
var Esq, Dir: TipoIndice;
    x       : TipoItem;

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;

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;

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


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: TipoIndice);
begin
  for i := 2 to n 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 := 20; {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 ('Selecao   ');
  Selecao (B, n);
  Testa (B, n);
  Copia (A,B,n);

  write ('Insercao  ');
  Insercao (B, n);
  Testa (B,n);
  Copia (A,B,n);

  write ('Shellsort ');
  Shellsort (B, n);
  Testa (B,n);
  Copia (A,B,n);

  write ('Quicksort ');
  Quicksort (B, n);
  Testa (B,n);
  Copia (A,B,n);

  write ('Heapsort  ');
  Heapsort (B, n);
  Testa (B,n);
  Copia (A,B,n);

end.