paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 21:28:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* TArrayHelper<>.QSort uses a simpler 'reasonable' metric that decrements from 2 log2(n) before changing to heapsort

Browse Source
This commit is contained in:
J. Gareth "Curious Kit" Moreton 2022-11-23 19:57:25 +00:00 committed by FPK
parent 1aa8f978bc
commit cce3280fdd
1 changed files with 19 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
packages/rtl-generics/src/generics.collections.pas
View File

@ -1058,9 +1058,8 @@ begin
while (n > INSERTION_SORT_THRESHOLD) and (reasonable > 0) do
begin
{ 'reasonable' loses 3/16 (~20%) on each partition, and on reaching zero, heap sort is performed.
This means -log13/16(n) ~=~ 3.3 * log2(n) partitions allowed. }
reasonable := reasonable div 2 + reasonable div 4 + reasonable div 16;
{ If 'reasonable' reaches zero, the algorithm changes to heapsort }
Dec(reasonable);
pivot := Median(p, n, cmp)^;
R := 0;
@ -1184,8 +1183,24 @@ end;
class procedure TArrayHelper<T>.QuickSort(var AValues: array of T; ALeft, ARight: SizeInt;
const AComparer: IComparer<T>);
var
N: SizeInt;
begin
QSort(PT(AValues) + ALeft, ARight - ALeft + 1, ARight - ALeft + 1, AComparer);
N := ARight - ALeft + 1;
if N > 1 then
{ Use BSR as a base-2 logarithm }
QSort(
PT(AValues) + ALeft,
N,
{$if defined(CPU64)}
2 * BsrQWord(QWord(N)),
{$elseif defined(CPU32)}
2 * BsrDWord(LongWord(N)),
{$elseif defined(CPU16)}
2 * BsrWord(Word(N)),
{$endif}
AComparer
);
end;
class function TArrayHelper<T>.BinarySearch(const AValues: array of T; const AItem: T;