Difference between revisions of "Array sort"
From Free Pascal wiki
Jump to navigationJump to searchm (→AnySort.pas) |
m (→AnySort.pas) |
||
Line 26: | Line 26: | ||
procedure AnyQuickSort(var Arr; idxL, idxH: Integer; | procedure AnyQuickSort(var Arr; idxL, idxH: Integer; | ||
− | Stride: Integer; CompareFunc: TCompareFunc; var SwapBuf); | + | Stride: Integer; CompareFunc: TCompareFunc; var SwapBuf, MedBuf); |
var | var | ||
ls,hs : Integer; | ls,hs : Integer; | ||
Line 41: | Line 41: | ||
hs:=hi*Stride; | hs:=hi*Stride; | ||
ms:=mi*Stride; | ms:=mi*Stride; | ||
+ | Move(pb[ms], medBuf, Stride); | ||
repeat | repeat | ||
− | while CompareFunc( pb[ls], | + | while CompareFunc( pb[ls], medBuf) < 0 do begin |
inc(ls, Stride); | inc(ls, Stride); | ||
inc(li); | inc(li); | ||
end; | end; | ||
− | while CompareFunc( | + | while CompareFunc( medBuf, pb[hs] ) < 0 do begin |
dec(hs, Stride); | dec(hs, Stride); | ||
dec(hi); | dec(hi); | ||
Line 65: | Line 66: | ||
var | var | ||
buf: array of byte; | buf: array of byte; | ||
+ | buf2: array of byte; | ||
begin | begin | ||
SetLength(buf, Stride); | SetLength(buf, Stride); | ||
− | AnyQuickSort(Arr, 0, Count-1, Stride, compareFunc, buf[0]); | + | SetLength(buf2, Stride); |
+ | AnyQuickSort(Arr, 0, Count-1, Stride, compareFunc, buf[0], buf2[0]); | ||
end; | end; | ||
Revision as of 08:46, 2 November 2020
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;