SA-MP/exgui/FindSort.pas
2023-12-16 23:31:23 +08:00

161 lines
4.6 KiB
ObjectPascal

{unit FindSort
Author: Wellington Lima dos Santos
Contact: wlsantos@alunos.ufv.br or santoswl@yahoo.com.br
Purposes:
1. Sort a Generic Array (CustomArray) by QuickSort algorithm, where
CustomArray is a var of type: array[LowIndex..HighIndex] of YourType;
2. Find an item by binary search algorithm
YourType is any standard type or defined type such as integer, double,
string, record, objects, etc.
Benefit: This routine is general and you only need to write a function
to compare the items of the array.
Penalty: The performance is 2 to 3x slower than classical QuickSort
compatibility: D2, D3, D4, D5
history: 28/06/2000 - Created with recursive QuickSort
15/07/2000 - Implementation of the non recursive QuickSort
distribution: Free! }
unit FindSort;
{$R+} // enable range checks
interface
uses
Classes, SysUtils;
function SortArray(var CustomArray; LowIndex, ItemSize, L, R : Integer;
CompareItems : TListSortCompare) : boolean;
function FindInArray(var SortedArray; LowIndex, ItemSize, ItemCount : Integer;
Item : Pointer; CompareItems : TListSortCompare; var Index : Integer) : Boolean;
implementation
resourcestring
SStackOverflowQS = 'Stack Overflow in Quick Sort';
{CustomArray = array[LowIndex..HighIndex] of YourType (Dynamic Arrays: CustomArray[0])
LowIndex = Low(CustomArray). In General is Zero, but...
ItemSize = SizeOf(CustomArray[Low(CustomArray)]) or SizeOf(YourType)
L, R = Sorted Range. (L >= LowIndex) and (R <= HighIndex)
CompareItems = identical to function used with TList.Sort(CompareItems)}
function SortArray(var CustomArray; LowIndex, ItemSize, L, R : Integer;
CompareItems : TListSortCompare) : boolean;
var
I, J, Level : Integer;
P, T : Pointer;
Base, Ip, Jp : ^Byte;
Stack : array[1..64] of record Ls, Rs : Integer; end;
// Based on a nice non-recursive QuickSort (Brad Williams, TV Sorting-SWAG)
// In my tests, the stack limit reached until 38 for 10^7 aleatoric integers.
begin
Result := False;
if (ItemSize < 1) or (R < L) or not Assigned(CompareItems) then
exit;
Result := True;
if R = L then
exit;
Result := False;
GetMem(P, ItemSize);
GetMem(T, ItemSize);
try
Base := @CustomArray;
Dec(Base, LowIndex * ItemSize);
Level := 1;
Stack[Level].Ls := L;
Stack[Level].Rs := R;
repeat
L := Stack[Level].Ls;
R := Stack[Level].Rs;
Dec(Level);
repeat
I := L;
J := R;
//Never change (L+R) div 2 to (L+R) shr 1, if (L+R) < 0 !
Move(Pointer(Integer(Base) + ((L + R) div 2) * ItemSize)^, P^, ItemSize);
repeat
Ip := Base; Inc(Ip, I * ItemSize);
Jp := Base; Inc(Jp, J * ItemSize);
while CompareItems(Ip, P) < 0 do
begin
Inc(I);
Inc(Ip, ItemSize);
end;
while CompareItems(Jp, P) > 0 do
begin
Dec(J);
Dec(Jp, ItemSize);
end;
if I <= J then
begin
Move(Ip^, T^, ItemSize);
Move(Jp^, Ip^, ItemSize);
Move(T^, Jp^, ItemSize);
Inc(I);
Dec(J);
end;
until I > J;
if I < R then
begin
Inc(Level);
if Level > High(Stack) then //Certainly your compare function have problems!
raise Exception.Create(SStackOverflowQS);
Stack[Level].Ls := I;
Stack[Level].Rs := R;
end;
R := J;
until L >= R;
until Level = 0;
Result := True;
finally
FreeMem(P);
FreeMem(T);
end;
end; // SortArray
{SortedArray = array[LowIndex..HighIndex] of YourType, just Sorted!
LowIndex = Low(SortedArray). In General is Zero, but...
ItemSize = SizeOf(SortedArray[Low(SortedArray)]) or SizeOf(YourType)
ItemCount = Number de Items in Array
Item = Pointer to searched Item. use the operator @
CompareItems = identical to function used with TList.Sort(CompareItems)
Index = Local where the Item is or will must be placed
Result = True if the item will be found.}
function FindInArray(var SortedArray; LowIndex, ItemSize, ItemCount : Integer;
Item : Pointer; CompareItems : TListSortCompare; var Index : Integer) : Boolean;
var
L, H, I, C : Integer;
It : Pointer;
begin
Result := False;
L := LowIndex;
H := LowIndex + ItemCount - 1;
while L <= H do
begin
//Never change (L+R) div 2 to (L+R) shr 1, if (L+R) < 0 !
I := (L + H) div 2;
Integer(It) := Integer(@SortedArray) + (I - LowIndex) * ItemSize;
C := CompareItems(It, Item);
if C < 0 then
L := I + 1
else
begin
H := I - 1;
if C = 0 then
Result := True;
end;
end;
Index := L;
end;
end.