Ir para o conteúdo

Método genérico de ordenação de arrays

Este documento apresenta uma unit que possui uma pequena classe genérica com um objectivo muito simples mas, ao mesmo tempo, interessante: ordenar um array que possua dados de qualquer tipo segundo um termo de comparação à escolha.

Ou seja, tentou-se encontrar uma forma de fazer algo semelhante ao seguinte:

Sort(arr, @compare);

Onde arr é o array com conteúdos de um tipo qualquer, e compare é a função que define o tipo de ordenamento que queremos para os dados.

Segue-se o código da unit e dois exemplos: um que ordena por ordem crescente um array de inteiros, e outro que ordena por ordem alfabética inversa uma lista de nomes.

A unit

Importante: A unit não está documentada.

{$mode objfpc}
unit UOrder;

interface
uses classes, sysutils;

type generic TOrdering<T> = class(TObject)
        private
           type TFnBool = function (a, b : T) : boolean;
                TArrayOfT = array of T;
        public
           procedure Sort(var arr : TArrayOfT; f : TFnBool);
     end;


implementation

procedure TOrdering.Sort(var arr : TArrayOfT; f : TFnBool);
var i, j : longint;
    temp : T;
begin
   for i := Low(arr) to High(arr)-1 do
      for j := i+1 to High(arr) do
         if f(arr[i], arr[j]) then begin
            temp := arr[i];
            arr[i] := arr[j];
            arr[j] := temp;
         end;
end;

end.

Testes

Importante: Os testes não estão documentados.

Teste nº 1 - ordenação por ordem crescente de Integers

Código

{$mode objfpc}
program teste1;
uses classes, sysutils,
     UOrder;

type TOrdInt = specialize TOrdering<integer>;
     TArrInt = array of integer;


function Greater(a, b : integer) : boolean;
begin
   Greater := a > b;
end;


procedure WriteArrInt(arr : TArrInt);
var i : integer;
begin
   for i in arr do
      write(i:3);
   writeln;
end;


var ordint : TOrdInt;
    l      : TArrInt;

begin
   try
      SetLength(l, 6);
      l[0] := 5;
      l[1] := 5;
      l[2] := 0;
      l[3] := 4;
      l[4] := 2;
      l[5] := 8;

      write('Initial array: ');
      WriteArrInt(l);
      writeln;

      ordint.Create;
      ordint.Sort(l, @Greater);
      ordint.Free;

      write('  Final array: ');
      WriteArrInt(l);

   except
      on ex:exception do writeln('[ERR: ', ex.classname, ' -> ', ex.message, ']');
   end;

   readln;  // pausa
end.

Output

Initial array:   5  5  0  4  2  8
  Final array:   0  2  4  5  5  8

Teste nº 2 - ordenação por ordem alfabética inversa de Strings

Código

{$mode objfpc}
program teste2;
uses classes, sysutils,
     UOrder;

type TOrdStr = specialize TOrdering<string>;
     TArrStr = array of string;


function Max(x, y : word) : word;
begin
   if x >= y then
      Max := x
   else
      Max := y;
end;


function AlphaBefore(p1, p2 : string) : boolean;
// Is p1 before p2 in the dictionary? It may not work with spaces!
var i : word;
begin
   AlphaBefore := true;
   for i := 1 to Max(Length(p1), Length(p2)) do
      if Ord(LowerCase(p1[i])) < Ord(LowerCase(p2[i])) then
         break
      else if Ord(LowerCase(p1[i])) > Ord(LowerCase(p2[i])) then begin
         AlphaBefore := false;
         break;
      end;
end;


procedure WriteArr(arr : TArrStr);
var s : string;
begin
   for s in arr do writeln(s);
   writeln;
end;


var ordstr : TOrdStr;
    names : TArrStr;

begin
   try
      SetLength(names, 4);
      names[0] := 'thoga31';
      names[1] := 'pwseo';
      names[2] := 'nunopicado';
      names[3] := 'Pascal';

      writeln('Initial array:');
      WriteArr(names);
      writeln;

      ordstr.Create;
      ordstr.Sort(names, @AlphaBefore);
      ordstr.Free;

      writeln('Final array:');
      WriteArr(names);

   except
      on ex:exception do writeln('[ERR: ', ex.classname, ' -> ', ex.message, ']');
   end;

   readln;
end.

Output

Initial array:
thoga31
pwseo
nunopicado
Pascal

Final array:
thoga31
pwseo
Pascal
nunopicado