Array sort
From Free Pascal wiki
A typical task is to sort an array. One of the problems is that an array could be of any type. Not a simple type, but more complicated types.
Prior to introducing Generics into Freepascal, sorting an array of arbitrary type could be achieve via untyped variables (implicit Pointers).
Features
- Fast
- any array data type
AnySort.pas
unit anysort;
{$ifdef fpc}{$mode delphi}{$H+}{$endif}
interface
type
TCompareFunc = function (const elem1, elem2): Integer;
procedure AnySort(var Arr; Count: Integer; Stride: Integer; CompareFunc: TCompareFunc);
implementation
type
TByteArray = array [Word] of byte;
PByteArray = ^TByteArray;
procedure AnyQuickSort(var Arr; idxL, idxH: Integer;
Stride: Integer; CompareFunc: TCompareFunc; var SwapBuf, MedBuf);
var
ls,hs : Integer;
li,hi : Integer;
mi : Integer;
ms : Integer;
pb : PByteArray;
begin
pb:=@Arr;
li:=idxL;
hi:=idxH;
mi:=(li+hi) div 2;
ls:=li*Stride;
hs:=hi*Stride;
ms:=mi*Stride;
Move(pb[ms], medBuf, Stride);
repeat
while CompareFunc( pb[ls], medBuf) < 0 do begin
inc(ls, Stride);
inc(li);
end;
while CompareFunc( medBuf, pb[hs] ) < 0 do begin
dec(hs, Stride);
dec(hi);
end;
if ls <= hs then begin
Move(pb[ls], SwapBuf, Stride);
Move(pb[hs], pb[ls], Stride);
Move(SwapBuf, pb[hs], Stride);
inc(ls, Stride); inc(li);
dec(hs, Stride); dec(hi);
end;
until ls>hs;
if hi>idxL then AnyQuickSort(Arr, idxL, hi, Stride, CompareFunc, SwapBuf);
if li<idxH then AnyQuickSort(Arr, li, idxH, Stride, CompareFunc, SwapBuf);
end;
procedure AnySort(var Arr; Count: Integer; Stride: Integer; CompareFunc: TCompareFunc);
var
buf: array of byte;
buf2: array of byte;
begin
SetLength(buf, Stride);
SetLength(buf2, Stride);
AnyQuickSort(Arr, 0, Count-1, Stride, compareFunc, buf[0], buf2[0]);
end;
end.
Here's an example on how to use AnySort() function to sort an array of Integer
interface
uses AnySort
procedure SortArrayInteger(var arr: array of Integer; count: Integer);
implementation
function CompareInt(const d1,d2): integer;
var
i1 : integer absolute d1;
i2 : integer absolute d2;
begin
if i1=i2 then Result:=0
else if i1<i2 then Result:=-1
else Result:=1;
end;
procedure SortArrayInteger(var arr: array of Integer; count: Integer);
begin
AnySort(arr, Count, sizeof(Integer), @CompareInt);
end;