diff --git a/exgui/FindSort.dcu b/exgui/FindSort.dcu new file mode 100644 index 0000000..d1698a2 Binary files /dev/null and b/exgui/FindSort.dcu differ diff --git a/exgui/FindSort.pas b/exgui/FindSort.pas new file mode 100644 index 0000000..022d7d4 --- /dev/null +++ b/exgui/FindSort.pas @@ -0,0 +1,160 @@ +{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. +