_TITLE "CGSortAlgorithmsLibraryAndTest12i" '* Quora: Is there an algorithm to fimd duplicate elements in an array in O(N) time? Of COURSE there is. There are actually MANY that are
'* not only efficient, but relatively simple. The simplest is a HashTable. However, this requires knowledge beforehand of the number of
'* elements constant reconstruction of the HashTable on exceeding the efficient Load Factor, aka "emptiness," which is roughly 20%. Past
'* this, searching and probing become worse than the typical O(1.25) cited in many research papers and backed by personal experience.
'* The second involves application of a VERY fast sorting method and either traversal or partial sort and binary search of the remainder.
'* There is no algorithm that does this in less than O(N) time, although there are asymptotically close heuristics.
'* my answer assumes no prior knowledge of data type beyond numeric.
'* first, we will start with the typical element by element search. VERY slow and complexity is O(N^2).
'* yes, this is abysmally slow, so testing only with a small number of elements.
'* this example includes my ENTIRE library of sorting algorithms, some slightly modified from standard.
'* all tested and verified are indicated by a date stamp
'* tested/verified
'*******************************************************************************************************************************************************************
'Date tested O() Algorithm name time(ms) in-place deployment special notes
'2018-Mar-13 N FlashSort (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, order&) 117 N requires inversion for descending order
'2018 Mar 13 NLogN QuickSortRecursive (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 148 Y Requires CPU stack, uses middle array element for
' partitioning step.
'2018 Mar 13 NLogN QSortRecursiveSimplified (CGSortLibArr() AS DOUBLE, start&, finish&) 160 Y Requires CPU stack
'2018nMar 13 NLogN QuickSortIterativeMedianOf3 (CGSortLibArr() AS DOUBLE, Start&, Finish&, order&) 161 Y Uses software-based stack, Median of Three
' Partitioning strategy used to defeat "QuickSort
' Killer" array arrangements for QuickSort algorithms
' using the middle element as the sole pivot chice.
' Remember, DDoS attacks using this flaw in Java?
'2018 Mar 13 NLogN QuickSortIterative (CGSortLibArr() AS DOUBLE, Start&, Finish&, order&) 164 Y Uses software-based stack, handy for old CPUs that do
' not support recursive stacks in hardware. Or just to
' implement for certainty where hardware or virtualization
' is not guaranteed to support hardware stacks.
'
'2018 Mar 13 N HashListSort (CGSortLibArr() AS DOUBLE, start AS LONG, Finish AS LONG, order&) 171 N Can be implemented without CGSortLibArr() with mods
' With the data type and range in this original demo
' HashListSort actually BEATS FlashSort by at least
' an 11% margin. Don't let this fool you. This is the
' result of a SINGLE run, and generalizing on a single
' run is not a good idea, which is why I assembled a
' test harness using multiple passes and ascending,
' descending order.
'2018 Mar 13 NLogN IntroSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 226 N uses MergeSort, HeapSort, InsertionSort and performs
' comparably and favorably to non-hybrid QuickSort,
' usually within a few percent or less.
'2018 Mar 13 NLogN QuickSortDualPivot (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 244 Y Not bulletproof but works for most cases of highly
' repetitive data fails for low-repetition data.
'2018 Mar 13 NLongN SnakeSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 250 N Auxiliary memory is O(N). Also a very nice-performing
' algorithm. Not the fastest (yes, compared to HashListSort
' with 70ms @ (0, 131071) elements, not even FlashSort can
' keep up.
'2018 Mar 13 NLogN MergeSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 257 N Auxiliary memory is O(N/2) when used with
' EfficientMerge
'2018 Mar 13 NLogN MergeSortTwoWay (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 287 N Good for memory-constrained systems
'2018 Mar 13 N RadixSort (a() AS DOUBLE, start&, finish&, order&) 296 N Only for integers, otherwise it will use MergeSort
' to maintain RadixSort's stability
'2018 Mar 14 BucketSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&, recurse%) 280 N Without recursion, 100 times slower 20812ns
' Final subarray sort done with MergeSort keeps this
' algorithm competitive.
'2018 Mar 13 SinglePassShellSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 335 Y Got this idea from reading LOTS of articles. Performs
' respectably.
'2018 Mar 13 PrimeGapSort2 (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 343 Y Invented by CodeGuy/Zom-B, uses wheel factorization
' to generate primes.
'2018 Mar 13 PostSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 351 N Large auxiliary overhead. Final sort of subarrays
' done with MergeSort also keeps this algorithm competitive
' Like BucketSort, except that it uses a fixed number of
' buckets. Using fewwer actually increases speed, at 1
' Bucket, it's essentially a MergeSort.
'2018 Mar 13 PrimeGapSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 382 Y Invented by CodeGuy. Proud to declare PrimeGapSort
' is competitive and performs on par with ShellSort or
' better. Uses gaps that are prime.
'2018 Mar 13 JoinSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 484 N A respectably quick algorithm. Also, not the fastest
' but for a comparison sort, good enough.
'2018 Mar 13 NLogN HeapSort (CGSortLibArr() AS DOUBLE, Start&, Finish&, order&) 492 Y
'2018 Mar 13 ShellSortMetzner (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 500 Y With this variant, it is appreciably faster than ShellSort.
'2018-Mar-13 ShellSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 546 Y
'2018 Mar 13 CombSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 898 Y
'2018 Mar 13 Nlog^2N BatcherOddEvenMergeSort (CGSortLibArr() AS DOUBLE, Start&, Finish&) 1093 Y Only works for power-of-2 sized arrays
'2018 Mar 13 SmoothSort (TypedCGSortLibArr() AS DataElement, order&) 1292 Y requires use of TYPE array) and only 0 to ubound.
' no ranges
'2018-Mar 13 ShellSortBidirectional (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 2421 Y
'2018 Mar 13 BitonicSort (CGSortLibArr() AS DOUBLE, lo&, n&, dir&) 2609 Y
'2018-Mar-13 N^2 InsertionSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 229133 Y Very fast for nearly-sorted arrays. Used as finishing
' run for many ShellSort variations.
'2018 Mar 13 N^2 InsertionSortBinary (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 330328 Y Supposedly faster than InsertionSort. Using randomized
' Double-precision, generally non-repeating, not proven
' in practice.
'2018 Mar 13 N^2 CycleSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) 784852 Y
' N^2 bubblesort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) ------
' N^2 CocktailSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) ------
' N^2 SelectionSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&) ------
' N^2 InsertionSortx (CGSortLibArr() AS DOUBLE, start&, finish&, order&) ------
' FlashSORTType (CGSortLibArr() AS FlashRec, start AS LONG, finish AS LONG, order&) ------ as yet untested. An experimental algorithm for use with
' string-type variables
'* InsertionSort(), BubbleSort(), MergeSort() are considered stable. The remainder either are not or as yet unconfirmed
'* I ran these individually and corrected flaws. Sorts that have times have been tested in ascending/descending order
'* this is a work in progress. The algorithms marked by ------ are too slow to be practical for this demo code
'* Tested on double-precision data.
'*******************************************************************************************************************************************************************
'[code=qb64]
casecount& = 0
copy$ = "select case SortChoose%" + crlf
copy$
= copy$
+ "case" + STR$(casecount&
) + crlf
copy$ = copy$ + t$ + crlf
casecount& = casecount& + 1
copy$ = copy$ + "end select" + crlf
'* this TYPE declaration MUST appear in your code to use my library
'* for Stabilized smoothsort
'Name AS STRING * 32
'* to here
PerformThis%(s&) = -1
SortTestN& = 63
SortThreshhold& = 16
outsf&
= _LOADFONT("c:\windows\fonts\cour.ttf", 14, "monospace")
Main_Sorted_From_N&
= LBOUND(TestCGSortLibArr
) Main_Sorted_To_N&
= UBOUND(TestCGSortLibArr
)
IF 0 THEN '* 104s is JUST too long for 65536 elements '* skip this element if it has already been found
IF ElementCounts
(SearcTestArrayIndex&
) <> -1 THEN FOR SearchNextOccurrence&
= SearchTestOccurrence&
+ 1 TO UBOUND(testarray
) IF ElementCounts
(SearchNextOccurrence&
) <> -1 THEN IF TestCGSortLibArr
(SearchTestArrayIndex&
) = TestCGSortLibArr
(SearchNextOccurrence&
) THEN ElementCounts(SearchTestArrayIndex&) = ElementCounts(SearchTestArrayIndex&) + 1
ElementCounts(SearchNextOccurrence&) = -1
IF ElementCounts
(SearchTestArrayIndex&
) > 1 THEN PRINT "("; TestCGSortLibArr
(SearchTestArrayIndex&
); ElementCounts
(SearchTestArrayIndex&
);
")";
'_FULLSCREEN
'* now we get a bit more clever and use a sorting method that isn't QuickSort, to bypass its potentially O(N^2) performance
'* One very fast algorithm posted in prior posts, KD Neubert FlashSort() comes to mind. Fast? Damn near O(N).
'* the new fastest sort I know of, invented by CodeGuy, beats FlashSort often enough to call a winner, especially for very
'* large N on repetitive sets.
NTrials& = 0 '* 1 less than you really want
IF PerformThis%
(SortChoose%
) THEN FOR SetTestArray&
= Main_Sorted_From_N&
TO Main_Sorted_To_N&
TestCGSortLibArr
(SetTestArray&
) = RND '*Main_Sorted_To_N& - SetTestArray& 'INT(RND * 1048576) AND 1 'TestArrayType(SetTestArray&).thekey = INT(256 * RND) '(RND * 1023) AND 1023
'TestArrayType(SetTestArray&).originalorder = SetTestArray&
FOR passes&
= 0 TO NTrials&
'KnuthShuffle TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&
'* TestCGSortLibArr
SortResults
(SortChoose%
).
Name = "[s+][i-][n ]Post" PostSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i-][n ]Flash" FlashSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]Shell" ShellSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]ShellBidirectional" ShellSortBidirectional TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]QuickRecursive" QuickSortRecursive TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NlogN]QuickIterative" QuickSortIterative TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]QuickDualPivot" QuickSortDualPivot TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]MergeRoutine" MergeSortRoutine TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]Bubble" BubbleSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][n^2 ]Cocktail" CocktailSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]InsertionBinary" InsertionSortBinary TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][n^1 ]Bucket" r% = 1
BucketSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&, r%
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]Heap" HeapSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]QuickIntrospective" QuickSortIntrospective TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]BubbleModified" BubbleSortModified TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]MergeTwoWay" MergeSortTwoWay TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]TreeUsingBST" TreeSortUsingBST TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'SortResults(SortChoose%).Name = "DistCountingSort"
'CountingSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'flashstring TestArrayType() ,Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'_CONTINUE
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]PrimeGap2(codeGuy/Zom-B)" primeGapSort2 TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]Comb" CombSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]Selection" SelectionSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][n^2 ]Cycle" cycleSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]ShellMetzner" shellSortMetzner TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]PrimeGap" PrimeGapSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]Insertion" InsertionSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i-][n ]HashList(CodeGuy)" HashListSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]Radix" RadixSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]BatcherOddEvenMerge" BatcherOddEvenMergeSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]ShellSinglePass" SinglePassShellSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]Bitonic" BitonicSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i-][NLogN]Snake" SnakeSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]Tim=========>" TimSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'SortResults(SortChoose%).Name = "DistCountingSort"
'DIM T_minmax AS MinMaxRec: Tscale# = 1
'CGScaleArrayToInteger TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&, T_minmax, Tscale#
'CGFrequencyCounts TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&, T_minmax, Tscale#
'_CONTINUE
SortResults
(SortChoose%
).
Name = "[s-][i+][*****]Join" JoinSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]QuickSimplifiedRecursive" QSortRecursiveSimplified TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'* Edsgar Djikstra's SmoothSort
SortResults
(SortChoose%
).
Name = "[s+][i+][*****]Smooth_TypedArray" REDIM TestArrayType
(0 TO Main_Sorted_To_N&
) TestArrayType(s&).originalorder = s&
TestArrayType(s&).thekey = TestCGSortLibArr(s&)
SmoothSort_TypedArray TestArrayType(), sortdir&
TestCGSortLibArr(s&) = TestArrayType(s&).thekey
subtracttime! = DeltaTime(x!, y!) + DeltaTime!(s!, t!)
SortResults(SortChoose%).AccumulatedTime = SortResults(SortChoose%).AccumulatedTime - subtracttime!
SortResults
(SortChoose%
).
Name = "[s-][i+][n^2 ]Gnome" GnomeSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][NLogN]QuickMedianOf3It" QuickSortIterativeMedianOf3 TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][n^2 ]SelectionUnstable" SelectionSortUnstable TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]InsertionRecursive" InsertionSortRecursive TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]MergeEmerge" MergeSortEmerge TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
'* necessary because this routine eats a LOT of stack
IF Main_Sorted_To_N&
- Main_Sorted_From_N&
> 8191 THEN PerformThis%(SortChoose%) = 0
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]BubbleRecursive" BubbleSortRecursive TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir
SortResults
(SortChoose%
).
Name = "[s+][i+][n^2 ]BubbleRecursiveEmerge<-------" BubbleSortRecursiveEmerge TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][NLogN]MergeSortEfficient->" MergeSortEfficient TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][N ]CountingInteger" CountingSortInteger TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][N ]CountingNonInteger" CountingSortNonInteger TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][N ]BeadInteger" BeadSortInteger TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i-][N ]BeadNonInteger" BeadSortNonInteger TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][N^2 ]Pancake" PancakeSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][N^2 ]PrimeGap2(Split)" PrimeGapSort2Split TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i+][N^2 ]OneZero" OneZeroSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][N ]UniqueInteger" UniqueIntegerSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s-][i-][N ]FlashSortGMMA" FlashSortGMMA TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][NLogN]MergeInsert" MergeInsert TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
SortResults
(SortChoose%
).
Name = "[s+][i+][N^2 ]ExchangeSort" ExchangeSort TestCGSortLibArr(), Main_Sorted_From_N&, Main_Sorted_To_N&, sortdir&
IF ArraySequenceCheck&
(TestCGSortLibArr
(), LBOUND(Testarray
), UBOUND(Testarray
), sortdir&
) THEN CountArrayRepetitions TestCGSortLibArr
(), LBOUND(Testarray
), UBOUND(Testarray
) PRINT USING "####.########## "; DeltaTime!
(u!
, v!
) SortResults(SortChoose%).AccumulatedTime = SortResults(SortChoose%).AccumulatedTime + DeltaTime!(u!, v!)
SortResults(SortChoose%).runs = SortResults(SortChoose%).runs + 1
SortResults(SortChoose%).Index = SortChoose%
SortResults(SortChoose%).accnum = SortResults(SortChoose%).accnum + SortTestN& + 1
'* an example of using the DataElement sorts
IF SortResults
(s&
).AccumulatedTime
> 0 THEN IF SortResults
(s&
).runs
> 0 THEN Results(Rcount&).originalorder = s&
Results
(Rcount&
).thekey
= CDBL(SortResults
(s&
).AccumulatedTime
/ SortResults
(s&
).accnum
) Rcount& = Rcount& + 1
Rcount& = Rcount& - 1
'* give Djikstra some props and use his sort to do an ascending order sort on Results()
SmoothSort_TypedArray Results(), 1
'* index to the fastest performing sort
LOCATE 2, 1:
PRINT "legend: [s]table, [i]n-place [complexity class]";
PRINT USING "n=###,###,###,###";
(Main_Sorted_To_N&
- Main_Sorted_From_N&
+ 1);
FirstOrder&
= Results
(LBOUND(Results
)).originalorder
halforder&
= Results
(LBOUND(results
) + (UBOUND(results
) - LBOUND(results
) + 1) \
2).originalorder
'COLOR (s& MOD 8) + 1, 1, 1
p& = Results(s&).originalorder
PRINT USING "####.######## "; SortResults
(p&
).AccumulatedTime;
PRINT USING "####.######## "; SortResults
(p&
).AccumulatedTime
/ SortResults
(p&
).accnum;
PRINT USING "####.############# "; SortResults
(p&
).AccumulatedTime
/ SortResults
(FirstOrder&
).AccumulatedTime
IF SortResults
(p&
).AccumulatedTime
/ SortResults
(halforder&
).AccumulatedTime
> SortThreshhold&
THEN PerformThis%(p&) = 0
'COLOR 2, 1, 1
'**********************
'CLS
'PRINT "N="; LTRIM$(STR$(Main_Sorted_To_N& - Main_Sorted_From_N& + 1))
'FOR h& = 0 TO 255
' IF SortResults(h&).runs > 0 THEN
' PRINT SortResults(h&).Name;
' PRINT USING "avg ###.###########"; SortResults(h&).AccumulatedTime / SortResults(h&).runs;
' 'PRINT SortResults(h&).runs;
' 'PRINT SortResults(h&).Index;
' PRINT USING "####.############## Index"; SortResults(h&).AccumulatedTime / SortResults(0).AccumulatedTime
' END IF
'NEXT
'* does what it says
'**********************
SortTestN& = SortTestN& * 2 + 1
LOOP 'UNTIL SortTestN& > 16777215
SUB CountArrayRepetitions
(CGSortLibArr
() AS DOUBLE, start&
, finish&
) ProbeCount&
= LBOUND(CGSortLibArr
) ElementCountIndex&
= LBOUND(ElementCounts
) s& = start&
ElementPointers(ElementCountIndex&) = s&
r& = s&
IF CGSortLibArr
(r&
) = CGSortLibArr
(s&
) THEN ElementCounts(ElementCountIndex&) = ElementCounts(ElementCountIndex&) + 1
r& = r& + 1
s& = r&
ElementCountIndex& = ElementCountIndex& + 1
PRINT "("; CGSortLibArr
(ElementPointers
(s&
)); ElementCounts
(s&
);
")";
'*****************************************************************************************************************
'*******************************
'* The Tiny Library Starts Here:
'*******************************
'* answers the question, what's the Kth smallest element of an array of numbers. Generally
'* regarded as an O(n) algorithm, provided the array is not already in order, otherwise it
'* COULD become O(n^2) (think bubble, cycle or selection sorts, all of which are SLOW on
'* unordered datasets.
DIM OSK_PivotX
AS DOUBLE '* MUST be same type as element of CGSortLibArr() '* These MUST be same type as start and finish
'*********************************************
OSK_lower = start
OSK_upper = finish - 1
WHILE OSK_lower
< OSK_upper
OSK_i = OSK_lower
OSK_j = OSK_upper
OSK_PivotX = CGSortLibArr(OSK_k)
WHILE CGSortLibArr
(OSK_i
) < OSK_PivotX
OSK_i = OSK_i + 1
WHILE CGSortLibArr
(OSK_j
) > OSK_PivotX
OSK_j = OSK_j - 1
SWAP CGSortLibArr
(OSK_i
), CGSortLibArr
(OSK_j
) OSK_i = OSK_i + 1
OSK_j = OSK_j - 1
OSK_lower = OSK_i
OSK_upper = OSK_j
'******************************************
'* still VERY competitive until N>16,777,216
'* however, now dethroned by HashListSort
' sorts CGSortLibArr() with Start& to Finish& elements by use of
' index vector L with M elements, with M ca. 0.1 Finish&.
' Translation of Karl-Dietrich Neubert's FlashSort
' algorithm into BASIC by Erdmann Hess.
' Arbitrary numeric type version.
' This WAS the absolute quickest sorting algorithm I can find for numeric arrays. Unfortunately, generalizing this for
' strings may require some work. sounds like a project to me. I have changed a couple things from the original,
' namely that .125 has been changed to .128. It seems that after a few runs on randomized data, a subscript error
' kept popping up. Traced it to L() and added a minor (about 2.4%) increase in the upper bound of L(). I suppose this
' could also be used for non-integer and non-string types as well.
'* KD Neubert FlashSort. Incredibly FAST numeric sort. This is a distribution sort, like BucketSort or PostSort, except far less overhead
'* in memory. Refactored By CodeGuy for the best clarity I can possibly provide. The original version has a .125(upperbound-lowerbound) array,
'* but was changed to .128(upperbound-lowerbound) avoid array bound errors. Tested. Fast. Works.
'*********************************************
'* change these:
'* to the same type as the array being sorted
'* change these:
'* to long for qbxx as qbxx has no _unsigned types
'* the original ratio was .125 but i kept getting array bounds errors
MIndex
= (INT(.128 * (finish
- start
+ 1)) + 1) OR 2
'* change these:
'* to the appropriate type for the range being sorted (must match start, finish variables)
'* don't mess:
DIM FlashC1
AS DOUBLE '* for some reason does not work with _float '* with this. it needs to be a double at the very least but float gives this a far greater range
'* more than likely more range than is practical. but ya never know (change this to double for qbxx)
' sorts array A with finish elements by use of
' index vector L with M elements, with M ca. 0.128(finish-start).
' Translation of Karl-Dietrich Neubert's FlashSort
' algorithm into BASIC by Erdmann Hess.
' Generalized Numeric Version -- recoded by codeguy
'* This is the absolute quickest sorting algorithm I can find for numeric arrays. Unfortunately, generalizing this for
'* strings may require some work. sounds like a project to me. I have changed a couple things from the original,
'* namely that .125 has been changed to .128. It seems that after a few runs on randomized data, a subscript error
'* kept popping up. Traced it to FlashTrackL() and added a minor (about 2.4&) increase in the upper bound of FlashTrackL().
'* I suppose this could also be used for non-integer and non-string types as well. Note: For very large N, HashListSort()
'* works even faster and has a similar memory footprint. But yes, this is still faster than QuickSort for N>10000 and like
'* HashListSort, operates in asymptotically close to O(N) time.
REM =============== CLASS FORMATION
=================
ANMiN = CGSortLibArr(start)
MaxValueIndex = finish
MinValueIndex = start
FOR FlashI
= start
TO finish
IF (CGSortLibArr
(FlashI
) > CGSortLibArr
(MaxValueIndex
)) THEN MaxValueIndex
= FlashI
IF (CGSortLibArr
(FlashI
) < CGSortLibArr
(MinValueIndex
)) THEN MinValueIndex
= FlashI
SWAP CGSortLibArr
(MinValueIndex
), CGSortLibArr
(start
): MinValueIndex
= start: ANMiN
= CGSortLibArr
(MinValueIndex
) SWAP CGSortLibArr
(MaxValueIndex
), CGSortLibArr
(finish
): MaxValueIndex
= finish
IF ANMiN
= CGSortLibArr
(MaxValueIndex
) THEN '* this is a monotonic sequence array and by definition is already sorted
FlashC1 = (MIndex - 1) / (CGSortLibArr(MaxValueIndex) - ANMiN)
FOR FlashI
= start
+ 1 TO finish
- 1 KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashI
) - ANMiN
)) + 1 FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1
FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)
REM ==================== PERMUTATION
================ FlashNMove = 0
FlashJ = start + 1
KIndex = MIndex
FinishMinusOne = finish - 1
WHILE (FlashNMove
< FinishMinusOne
) WHILE (FlashJ
> FlashTrackL
(KIndex
)) FlashJ = FlashJ + 1
KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashJ
) - ANMiN
)) + 1 flash = CGSortLibArr(FlashJ)
IF (FlashJ
= (FlashTrackL
(KIndex
) + 1)) THEN IF FlashNMove
< (FinishMinusOne
) THEN KIndex
= INT(FlashC1
* (flash
- ANMiN
)) + 1 hold = CGSortLibArr(FlashTrackL(KIndex))
CGSortLibArr(FlashTrackL(KIndex)) = flash
flash = hold
FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1
FlashNMove = FlashNMove + 1
'================= Insertion Sort============
'* sort subranges
'********************* insertionsortz CGSortLibArr(), FlashTrackL(SIndex - 1), FlashTrackL(SIndex) - 1, order&
FOR FlashI
= FlashTrackL
(SIndex
) - 1 TO FlashTrackL
(SIndex
- 1) STEP -1 IF (CGSortLibArr
(FlashI
+ 1) < CGSortLibArr
(FlashI
)) THEN hold = CGSortLibArr(FlashI)
NextFlashJ = FlashI
FlashJ = NextFlashJ
IF FlashJ
< FlashTrackL
(SIndex
) THEN NextFlashJ = FlashJ + 1
IF (CGSortLibArr
(NextFlashJ
) < hold
) THEN SWAP CGSortLibArr
(FlashJ
), CGSortLibArr
(NextFlashJ
) CGSortLibArr(FlashJ) = hold
'* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.
FlashI = start
FlashJ = finish
SWAP CGSortLibArr
(FlashI
), CGSortLibArr
(FlashJ
) FlashI = FlashI + 1
FlashJ = FlashJ - 1
'********************
'* InsertionSort is a simple to construct sort. Generally because of its O(n^2) running time, it's usually limited to VERY short runs
'* or used as a final sorting stage of many sorts. it is stable. The advantage of this sort for nearly sorted arrays is it runs in nearly O(n) time.
'* InsertionSort is adaptive, meaning it takes advantage of pre-existing order. Modified for faster performance on already-sorted data 21 Apr 2018.
'********************
FOR InSort_Local_i
= start
+ 1 TO finish
InSort_Local_j = InSort_Local_i - 1
IF CGSortLibArr
(InSort_Local_i
) < CGSortLibArr
(InSort_Local_j
) THEN InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
IF (InSort_Local_ArrayTemp
< CGSortLibArr
(InSort_Local_j
)) THEN CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j - 1
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
FOR InSort_Local_i
= start
+ 1 TO finish
InSort_Local_j = InSort_Local_i - 1
IF CGSortLibArr
(InSort_Local_i
) > CGSortLibArr
(InSort_Local_j
) THEN InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
IF (InSort_Local_ArrayTemp
> CGSortLibArr
(InSort_Local_j
)) THEN CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
InSort_Local_j = InSort_Local_j - 1
CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
'SUB InsertionSort (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, order&)
' DIM InSort_Local_ArrayTemp AS DOUBLE
' DIM InSort_Local_i AS LONG
' DIM InSort_Local_j AS LONG
' SELECT CASE order&
' CASE 1
' FOR InSort_Local_i = start + 1 TO finish
' InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
' InSort_Local_j = InSort_Local_i - 1
' DO UNTIL InSort_Local_j < start
' IF (InSort_Local_ArrayTemp < CGSortLibArr(InSort_Local_j)) THEN
' CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
' InSort_Local_j = InSort_Local_j - 1
' ELSE
' EXIT DO
' END IF
' LOOP
' CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
' NEXT
' CASE ELSE
' FOR InSort_Local_i = start + 1 TO finish
' InSort_Local_ArrayTemp = CGSortLibArr(InSort_Local_i)
' InSort_Local_j = InSort_Local_i - 1
' DO UNTIL InSort_Local_j < start
' IF (InSort_Local_ArrayTemp > CGSortLibArr(InSort_Local_j)) THEN
' CGSortLibArr(InSort_Local_j + 1) = CGSortLibArr(InSort_Local_j)
' InSort_Local_j = InSort_Local_j - 1
' ELSE
' EXIT DO
' END IF
' LOOP
' CGSortLibArr(InSort_Local_j + 1) = InSort_Local_ArrayTemp
' NEXT
' END SELECT
'END SUB
'**********************************
'* Asymmetric performance and stack overflows make this algorithm a dog. BinaaryInsertionSort is almost twice
'* twice as fast and does not cause recursion problems. Time for descending sort is twice that of ascending.
'* mostly a conversation piece.
'* [s+][i+][n^2 ]
'* this will help prevent stack overflows
InsertionSort CgSortLibArr(), start, finish, order&
InsertionSortRecursive CgSortLibArr(), start, finish - 1, order&
last = CgSortLibArr(finish)
j = finish - 1
IF CgSortLibArr
(j
) > last
THEN CgSortLibArr(j + 1) = CgSortLibArr(j)
j = j - 1
CgSortLibArr(j + 1) = last
last = CgSortLibArr(finish)
j = finish - 1
IF CgSortLibArr
(j
) < last
THEN CgSortLibArr(j + 1) = CgSortLibArr(j)
j = j - 1
CgSortLibArr(j + 1) = last
'******************************
'* ShellSort compares elements a gap distance apart, scans the array for out-of-order elements until none are
'* found and then continues reducing this gap distance until it reaches 0. It is not a stable sort, meaning elements
'* of equal value may appear in a position not the same order as it appears in the original array. It is reasonably easy to
'* code, adaptable for any data type and runs in reasonable time, thought to be around O(n^(5/4)). There are Numerous gap
'* reduction methods. The most "popular" being the (Gap/2) method. I have made several modifications to aid running time,
'* namely tracking the first and last position a swap occurred and using this to only scan to that point or less on successive
'* passes. The last pass of shellsort is the same as InsertionSort.
'******************************
SUB ShellSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) IF CGSortLibArr
(start&
) > CGSortLibArr
(finish&
) THEN SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) ShellSortGap& = (finish& - start&) \ 2
LoopCount& = 0
xstart& = start&
xfinish& = finish& - ShellSortGap&
MaxPasses& = (finish& - start&) \ ShellSortGap&
xfirst& = xfinish&
FOR ShellSortS&
= xstart&
TO xfinish&
IF CGSortLibArr
(ShellSortS&
) > CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) THEN SWAP CGSortLibArr
(ShellSortS&
), CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) Last& = ShellSortS&
xfirst& = ShellSortS&
xfinish& = Last&
xstart& = xfirst&
LoopCount& = LoopCount& + 1
LOOP WHILE LoopCount&
< MaxPasses&
AND (xfinish&
- xstart&
) >= ShellSortGap&
ShellSortGap& = ShellSortGap& \ 2
InsertionSort CGSortLibArr(), start&, finish&, order&
ShellSortGap& = (finish& - start&) \ 2
LoopCount& = 0
xstart& = start&
xfinish& = finish& - ShellSortGap&
MaxPasses& = (finish& - start&) \ ShellSortGap&
xfirst& = xfinish&
FOR ShellSortS&
= xstart&
TO xfinish&
IF CGSortLibArr
(ShellSortS&
) < CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) THEN SWAP CGSortLibArr
(ShellSortS&
), CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) Last& = ShellSortS&
xfirst& = ShellSortS&
xfinish& = Last&
xstart& = xfirst&
LoopCount& = LoopCount& + 1
LOOP WHILE LoopCount&
< MaxPasses&
AND (xfinish&
- xstart&
) >= ShellSortGap&
ShellSortGap& = ShellSortGap& \ 2
InsertionSort CGSortLibArr(), start&, finish&, order&
'*******************************************
'* this has been modified to become a bidirectional shellsort, which is far faster than the bubblesort version, which is a special case where
'* gap& is 1, and runs in polynomial o(n^1(5/4)) time when like its unidirectional predecessor. Not Stable. No practical use in real life I've
'* seen, but entertaining if visualized.
'*******************************************
SUB ShellSortBidirectional
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) gap& = (finish& - start& + 1) \ 2
up% = -1: down% = -1: passes& = 0: maxpasses& = (finish& - start& + 1) \ gap& - 1
startup& = start&: endup& = finish& - gap&: FirstUp& = finish& - gap&: LastUp& = start&
startdn& = finish&: enddown& = start& + gap&: FirstDown& = start& + gap&: LastDown& = finish&
passes& = 0
up% = 0
FOR i&
= startup&
TO endup&
IF CGSortLibArr
(i&
) > CGSortLibArr
(i&
+ gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ gap&
) FirstUp& = i&
LastUp& = i&
up% = -1
startup& = FirstUp&
endup& = LastUp&
'*******************************
down% = 0
IF CGSortLibArr
(i&
) < CGSortLibArr
(i&
- gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
- gap&
) FirstDown& = i&
LastDown& = i&
down% = -1
startdn& = FirstDown&
enddown& = LastDown&
SWAP FirstDown&
, LastDown&
IF passes&
< (enddown&
- startdown&
) \ gap&
- 1 OR passes&
< (endup&
- startup&
) \ gap&
- 1 THEN passes& = passes& + 1
gap& = gap& \ 2
gap& = (finish& - start& + 1) \ 2
up% = -1: down% = -1: passes& = 0: maxpasses& = (finish& - start& + 1) \ gap& - 1
startup& = start&: endup& = finish& - gap&: FirstUp& = finish& - gap&: LastUp& = start&
startdn& = finish&: enddown& = start& + gap&: FirstDown& = start& + gap&: LastDown& = finish&
up% = 0
FOR i&
= startup&
TO endup&
IF CGSortLibArr
(i&
) < CGSortLibArr
(i&
+ gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ gap&
) FirstUp& = i&
LastUp& = i&
up% = -1
startup& = FirstUp&
endup& = LastUp&
'*******************************
down% = 0
IF CGSortLibArr
(i&
) > CGSortLibArr
(i&
- gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
- gap&
) FirstDown& = i&
LastDown& = i&
down% = -1
startdn& = FirstDown&
enddown& = LastDown&
SWAP FirstDown&
, LastDown&
IF passes&
< (enddown&
- startdown&
) \ gap&
- 1 OR passes&
< (endup&
- startup&
) \ gap&
- 1 THEN passes& = passes& + 1
gap& = gap& \ 2
'*******************************************
'* TESTED -- WORKS
'* QuickSortRecursive is reputedly the "fastest sort." This is not true in all cases. One way to defeat QuickSort and send it into
'* polynomial time O(n^2) is to present it with an already-sorted array. There are safeguards to this. One to shuffle the array
'* before executing quicksort or in the case of IntroSort, revert to MergeSort once a certain level of recursion or InsertionSort
'* once a small (usually 15-31) sublist size is reached.
'* Often mistakenly referred to as the fastest sort, it does around NLogN comparisons, which is the lower bound for
'* comparison sorts. Fast? Generally, but not always. This is the recursive version, fine for most modern processors that support
'* the use of hardware stacks. This is a divide-and-conquer algorithm as is MergeSort.
SUB QuickSortRecursive
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) '* This is CRITICAL
IF CGSortLibArr
(start&
) > CGSortLibArr
(finish&
) THEN SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) IF CGSortLibArr
(start&
) < CGSortLibArr
(finish&
) THEN SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) QuickSortIJ CGSortLibArr(), start&, finish&, i&, j&, order&
IF (i&
- start&
) < (finish&
- j&
) THEN QuickSortRecursive CGSortLibArr(), start&, j&, order&
QuickSortRecursive CGSortLibArr(), i&, finish&, order&
QuickSortRecursive CGSortLibArr(), i&, finish&, order&
QuickSortRecursive CGSortLibArr(), start&, j&, order&
'*********************************
'* TESTED -- WORKS
'* This is the iterative version of QuickSort, using a software stack, useful for OLD processors lacking hardware registers to support
'* recursion. Operationally, it is very much the same as the recursive version except the "stack" is software-based.
'* Modified 2018 March 13 for stack bounds correction. Also modified to indicate local variables, and make changing variables as
'* necessary to accommodate range and type more straightforward.
DIM QSI_Local_Compare
AS DOUBLE '* MUST be same type as element of CGSortLibArr() '* These MUST be the appropriate type for the range being sorted
'****************************************************************
'* Integer suffices for QSI_Local_MinStackPtr unless you're sorting more than 2^32767 elements.
DIM QSI_Local_MinStackPtr
AS INTEGER: QSI_Local_MinStackPtr
= 0 DIM QSI_Local_QSI_local_CurrentStackPtr
AS INTEGER: QSI_Local_QSI_local_CurrentStackPtr
= 0 DIM QSI_Local_FinishMinusStart
AS LONG: QSI_Local_FinishMinusStart
= QSIFinish
- QSIStart
'* yes, the equation log(QSIfinish-QSIstart)/log(2)+1 works too
QSI_local_Remainder
= QSI_Local_FinishMinusStart
- (2 * INT(QSI_Local_FinishMinusStart
/ 2)) QSI_Local_FinishMinusStart = (QSI_Local_FinishMinusStart - QSI_local_Remainder) / 2
QSI_Local_MinStackPtr = QSI_Local_MinStackPtr + 1
'* MUST be appropriate type to handle the range (QSIfinish-QSIstart) being sorted
QSI_local_CurrentStackPtr = 0
QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSIStart
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSIFinish
QSI_Local_Low = QSI_LStack(QSI_local_CurrentStackPtr, 0)
QSI_Local_Hi = QSI_LStack(QSI_local_CurrentStackPtr, 1)
QSI_Local_I = QSI_Local_Low
QSI_local_J = QSI_Local_Hi
QSI_Local_Mid = QSI_Local_Low + (QSI_Local_Hi - QSI_Local_Low) \ 2
QSI_Local_Compare = CGSortLibArr(QSI_Local_Mid)
DO WHILE CGSortLibArr
(QSI_Local_I
) < QSI_Local_Compare
QSI_Local_I = QSI_Local_I + 1
DO WHILE CGSortLibArr
(QSI_local_J
) > QSI_Local_Compare
QSI_local_J = QSI_local_J - 1
IF QSI_Local_I
<= QSI_local_J
THEN SWAP CGSortLibArr
(QSI_Local_I
), CGSortLibArr
(QSI_local_J
) QSI_Local_I = QSI_Local_I + 1
QSI_local_J = QSI_local_J - 1
DO WHILE CGSortLibArr
(QSI_Local_I
) > QSI_Local_Compare
QSI_Local_I = QSI_Local_I + 1
DO WHILE CGSortLibArr
(QSI_local_J
) < QSI_Local_Compare
QSI_local_J = QSI_local_J - 1
IF QSI_Local_I
<= QSI_local_J
THEN SWAP CGSortLibArr
(QSI_Local_I
), CGSortLibArr
(QSI_local_J
) QSI_Local_I = QSI_Local_I + 1
QSI_local_J = QSI_local_J - 1
IF QSI_local_J
- QSI_Local_Low
< QSI_Local_Hi
- QSI_Local_I
THEN IF QSI_Local_I
< QSI_Local_Hi
THEN QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSI_Local_I
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSI_Local_Hi
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr + 1
QSI_Local_Hi = QSI_local_J
IF QSI_Local_Low
< QSI_local_J
THEN QSI_LStack(QSI_local_CurrentStackPtr, 0) = QSI_Local_Low
QSI_LStack(QSI_local_CurrentStackPtr, 1) = QSI_local_J
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr + 1
QSI_Local_Low = QSI_Local_I
QSI_local_CurrentStackPtr = QSI_local_CurrentStackPtr - 1
'************************
'* TESTED -- WORKS
'* Yaroslavsky Dual-pivot QuickSort is useful for arrays having many repeating elements. Will still fail on some inputs but better than standard QuickSort
'* for the same lack of entropy in an array. This is a version of the standard Java QuickSort. There is a 3-pivot version, also adaptive.
'************************
SUB QuickSortDualPivot
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) CompareP = CGSortLibArr(start&)
CompareQ = CGSortLibArr(finish&)
SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) l& = start& + 1
k& = l&
g& = finish& - 1
IF CGSortLibArr
(k&
) < CompareP
THEN SWAP CGSortLibArr
(k&
), CGSortLibArr
(l&
) l& = l& + 1
IF CGSortLibArr
(k&
) >= CompareQ
THEN WHILE CGSortLibArr
(g&
) >= CompareQ
AND k&
< g&
g& = g& - 1
SWAP CGSortLibArr
(k&
), CGSortLibArr
(g&
) g& = g& - 1
IF CGSortLibArr
(k&
) <= CompareP
THEN SWAP CGSortLibArr
(k&
), CGSortLibArr
(l&
) l& = l& + 1
k& = k& + 1
IF CGSortLibArr
(k&
) > CompareP
THEN SWAP CGSortLibArr
(k&
), CGSortLibArr
(l&
) l& = l& + 1
IF CGSortLibArr
(k&
) <= CompareQ
THEN WHILE CGSortLibArr
(g&
) <= CompareQ
AND k&
< g&
g& = g& - 1
SWAP CGSortLibArr
(k&
), CGSortLibArr
(g&
) g& = g& - 1
IF CGSortLibArr
(k&
) >= CompareP
THEN SWAP CGSortLibArr
(k&
), CGSortLibArr
(l&
) l& = l& + 1
k& = k& + 1
l& = l& - 1
g& = g& + 1
SWAP CGSortLibArr
(start&
), CGSortLibArr
(l&
) SWAP CGSortLibArr
(finish&
), CGSortLibArr
(g&
) QuickSortDualPivot CGSortLibArr(), start&, l& - 1, order&
QuickSortDualPivot CGSortLibArr(), l& + 1, g& - 1, order&
QuickSortDualPivot CGSortLibArr(), g& + 1, finish&, order&
'***********************
'* MergeSort is an O(NlogN) complexity divide and conquer stable sorting algorithm. The primary source of lag is the array copying.
'* The number of recurive calls is the same as the number of elements. If stability and predictable, undefeatable running time are
'* your sorting goals, this is an excellent choice. The memory overhead is approximately N/2 plus a few variables. With
'* EfficientMerge, memory overhead is halved, thus saving costly array copying. On my machine, this method is faster than the
'* standard MergeSort using the MergeRoutine() method.
'***********************
SUB MergeSortEmerge
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) middle& = start& + (finish& - start&) \ 2
MergeSortEmerge CGSortLibArr(), start&, middle&, order&
MergeSortEmerge CGSortLibArr(), middle& + 1, finish&, order&
EfficientMerge CGSortLibArr(), start&, finish&, order&
InsertionSort CGSortLibArr(), start&, finish&, order&
'*******************************
'* This is the standard MergeSort using the MergeRoutine() method. This is an example of head recursion, where recursive calls precede
'* other procedures.
'*******************************
SUB MergeSortRoutine
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) middle& = start& + (finish& - start&) \ 2
MergeSortRoutine CGSortLibArr(), start&, middle&, order&
MergeSortRoutine CGSortLibArr(), middle& + 1, finish&, order&
MergeRoutine CGSortLibArr(), start&, finish&, order&
InsertionSort CGSortLibArr(), start&, finish&, order&
'**********************************************
'* BubbleSort is a terrible performer on random arrays. It is good for nearly sorted arrays.
'* Average-case quadratic performance that is not adaptive makes this sort unsuitable for even small N
'* (here, finish - start).
'**********************************************
SUB BubbleSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) changed& = 0
FOR I&
= start&
TO finish&
- 1 IF CGSortLibArr
(I&
) > CGSortLibArr
(I&
+ 1) THEN SWAP CGSortLibArr
(I&
), CGSortLibArr
(I&
+ 1) changed& = -1
changed& = 0
FOR I&
= start&
TO finish&
- 1 IF CGSortLibArr
(I&
) < CGSortLibArr
(I&
+ 1) THEN SWAP CGSortLibArr
(I&
), CGSortLibArr
(I&
+ 1) changed& = -1
'**************************
'* another variation of bubblesort, CocktailSort also runs in o(n^2) and essentially scans up and down the array swapping out-of-order
'* elements until none are found. Stable, mostly a conversation piece.
'**************************
SUB CocktailSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) runs& = 0
p& = finish& - runs&
done& = 1 '* assume it's sorted
FOR i&
= start&
+ runs&
TO finish&
- runs&
- 1 IF CGSortLibArr
(i&
) > CGSortLibArr
(i&
+ 1) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ 1) done& = 0
IF CGSortLibArr
(p&
) < CGSortLibArr
(p&
- 1) THEN SWAP CGSortLibArr
(p&
), CGSortLibArr
(p&
- 1) done& = 0
p& = p& - 1
runs& = runs& + 1
runs& = 0
p& = finish& - runs&
done& = 1 '* assume it's sorted
FOR i&
= start&
+ runs&
TO finish&
- runs&
- 1 IF CGSortLibArr
(i&
) < CGSortLibArr
(i&
+ 1) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ 1) done& = 0
IF CGSortLibArr
(p&
) > CGSortLibArr
(p&
- 1) THEN SWAP CGSortLibArr
(p&
), CGSortLibArr
(p&
- 1) done& = 0
p& = p& - 1
runs& = runs& + 1
'******************************
'* this one is horrible with stack. No speed improvement and generally quite limited
'* because of its extremenly heavy use of stack.
'******************************
FOR c&
= startIndex
TO endIndex
- 1 IF CGSortLibArr
(c&
) > CGSortLibArr
(c&
+ 1) THEN SWAP CGSortLibArr
(c&
), CGSortLibArr
(c&
+ 1) BubbleSortRecursive CGSortLibArr(), startIndex, endIndex - 1, order&
FOR c&
= startIndex
TO endIndex
- 1 IF CGSortLibArr
(c&
) < CGSortLibArr
(c&
+ 1) THEN SWAP CGSortLibArr
(c&
), CGSortLibArr
(c&
+ 1) BubbleSortRecursive CGSortLibArr(), startIndex, endIndex - 1, order&
'SUB CountingSort (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
' DIM CountingSortMinMax AS MinMaxRec
' GetMinMaxArray CGSortLibArr(), start&, finish&, CountingSortMinMax
' IF CGSortLibArr(CountingSortMinMax.min) < CGSortLibArr(CountingSortMinMax.max) THEN
' REDIM csCounts(0 TO (finish& - start&)) AS LONG
' FOR s& = start& TO finish&
' '* NthPlace& (a() AS DOUBLE, NPMMrec AS MinMaxRec, start AS LONG, finish AS LONG, order&, npindex AS LONG)
' index& = NthPlace&(CGSortLibArr(), CountingSortMinMax, 0, finish& - start&, order&, s&)
' PRINT CGSortLibArr(s&); finish& - start&; index& > (finish& - start&); index&; CGSortLibArr(s&) - CGSortLibArr(CountingSortMinMax.min)
' csCounts(index&) = csCounts(index&) + 1
' '_DELAY .25
' NEXT
' index& = start&
' 'FOR s# = cs_Min TO cs_max
' ' WHILE csCounts(s#)
' ' CGSortLibArr(index&) = s#
' ' index& = index& + 1
' ' csCounts(s#) = csCounts(s#) - 1
' ' WEND
' 'NEXT
' ERASE csCounts
' InsertionSort CGSortLibArr(), start&, finish&, order&
' END IF
'END SUB
'**********************
'* helper function for InsertionSortBinary exactly the same as a binary search which runs in O(LogN) time.
'FUNCTION BinaryB& (CGSortLibArr() AS DOUBLE, start&, Nio&)
' Bsrcha& = start&
' BsrchB& = start& + Nio&
' DO
' BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2
' IF CGSortLibArr(BsrchC&) < CGSortLibArr(Nio&) THEN
' Bsrcha& = BsrchC& + 1
' ELSE
' BsrchB& = BsrchC&
' END IF
' LOOP WHILE Bsrcha& < BsrchB&
' BinaryB& = BsrchB&
'END FUNCTION
'*****************************
'* InsertionSortBinary uses Binary Search to find the correct position of an array element in the portion already sorted.
'* It's approximately 25 percent faster than standard InsertionSort in SOME cases.
'*****************************
'SUB InsertionSortBinary (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
' SELECT CASE order&
' CASE 1
' Nsorted& = 0
' DO
' f& = BinaryB&(CGSortLibArr(), start&, Nsorted&)
' p& = start& + Nsorted&
' WHILE p& > f&
' x& = p& - 1
' SWAP CGSortLibArr(p&), CGSortLibArr(x&)
' p& = x&
' WEND
' Nsorted& = Nsorted& + 1
' LOOP UNTIL Nsorted& > finish& - start&
' CASE ELSE
' Nsorted& = 0
' DO
' f& = BinaryB&(CGSortLibArr(), start&, Nsorted&)
' p& = start& + Nsorted&
' WHILE p& > f&
' x& = p& - 1
' SWAP CGSortLibArr(p&), CGSortLibArr(x&)
' p& = x&
' WEND
' Nsorted& = Nsorted& + 1
' LOOP UNTIL Nsorted& > finish& - start&
' IF CGSortLibArr(start&) <> CGSortLibArr(finish&) THEN
' StableInvert CGSortLibArr(), start&, finish&, 1
' END IF
' END SELECT
'END SUB
'SUB InsertionSortBinary (CGSortLibArr() AS DOUBLE, start&, finish&, order&)
' DIM InSortBinary_NSorted AS LONG
' DIM InSortBinary_F AS LONG
' DIM InSortBinary_P AS LONG
' DIM InSortBinary_X AS LONG
' SELECT CASE order&
' CASE 1
' InSortBinary_NSorted = 0
' DO
' InSortBinary_F = BinaryB&(CGSortLibArr(), start&, InSortBinary_NSorted, order&)
' InSortBinary_P = start& + InSortBinary_NSorted
' WHILE InSortBinary_P > InSortBinary_F
' InSortBinary_X = InSortBinary_P - 1
' SWAP CGSortLibArr(InSortBinary_P), CGSortLibArr(InSortBinary_X)
' InSortBinary_P = InSortBinary_X
' WEND
' InSortBinary_NSorted = InSortBinary_NSorted + 1
' LOOP UNTIL InSortBinary_NSorted > finish& - start&
' CASE ELSE
' InSortBinary_NSorted = 0
' DO
' InSortBinary_F = BinaryB&(CGSortLibArr(), start&, InSortBinary_NSorted, order&)
' InSortBinary_P = start& + InSortBinary_NSorted
' WHILE InSortBinary_P > InSortBinary_F
' InSortBinary_X = InSortBinary_P - 1
' SWAP CGSortLibArr(InSortBinary_P), CGSortLibArr(InSortBinary_X)
' InSortBinary_P = InSortBinary_X
' WEND
' InSortBinary_NSorted = InSortBinary_NSorted + 1
' LOOP UNTIL InSortBinary_NSorted > finish& - start&
' END SELECT
'END SUB
'FUNCTION BinaryB& (CGSortLibArr() AS DOUBLE, start&, Nio&, order&)
' IF order& = 1 THEN
' Bsrcha& = start&
' BsrchB& = start& + Nio&
' DO
' BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2
' IF CGSortLibArr(BsrchC&) < CGSortLibArr(Nio&) THEN
' Bsrcha& = BsrchC& + 1
' ELSE
' BsrchB& = BsrchC&
' END IF
' LOOP WHILE Bsrcha& < BsrchB&
' BinaryB& = BsrchB&
' ELSE
' Bsrcha& = start&
' BsrchB& = start& + Nio&
' DO
' BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2
' IF CGSortLibArr(BsrchC&) > CGSortLibArr(Nio&) THEN
' Bsrcha& = BsrchC& + 1
' ELSE
' BsrchB& = BsrchC&
' END IF
' LOOP WHILE Bsrcha& < BsrchB&
' BinaryB& = BsrchB&
' END IF
'END FUNCTION
'**************************************
'* Reworked to present correct results. Approximately (20-30)% faster than the standard version for unordered data.
'* Recommended uses: sorting mostly ordered data or runs that are 1024 or less (about 3.9ms/GHz for doubl-precision).
'* Yes, there are faster, but they are not strictly in-place (some require stack (software or hardware), or auxiliary
'* storage for copies of the array range to be sorted. and can be made to go quadratic, thus being no better or
'* actually worse than InsertionSortBinary(). The complexity class is still O(n^2), but for the use cases listed prior,
'* InsertionSortBinary() provides a nice performance profile. This algorithm can be adapted EASILY to other data types.
'**************************************
SUB InsertionSortBinary
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) InSortBinary_NSorted = 0
InSortBinary_F = InsertionBinaryB&(CGSortLibArr(), start&, InSortBinary_NSorted, order&)
InSortBinary_P = start& + InSortBinary_NSorted
WHILE InSortBinary_P
> InSortBinary_F
InSortBinary_X = InSortBinary_P - 1
SWAP CGSortLibArr
(InSortBinary_P
), CGSortLibArr
(InSortBinary_X
) InSortBinary_P = InSortBinary_X
InSortBinary_NSorted = InSortBinary_NSorted + 1
LOOP UNTIL InSortBinary_NSorted
> finish&
- start&
FUNCTION InsertionBinaryB&
(CGSortLibArr
() AS DOUBLE, start&
, NumberAlreadyOrdered&
, order&
) IF NumberAlreadyOrdered&
> 0 THEN Bsrcha& = start&
BsrchB& = start& + NumberAlreadyOrdered&
IF CGSortLibArr
(start&
+ NumberAlreadyOrdered&
) < CGSortLibArr
(start&
+ NumberAlreadyOrdered&
- 1) THEN BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2
IF CGSortLibArr
(BsrchC&
) < CGSortLibArr
(NumberAlreadyOrdered&
) THEN Bsrcha& = BsrchC& + 1
BsrchB& = BsrchC&
InsertionBinaryB& = BsrchB&
Bsrcha& = start&
BsrchB& = start& + NumberAlreadyOrdered&
IF CGSortLibArr
(start&
+ NumberAlreadyOrdered&
) > CGSortLibArr
(start&
+ NumberAlreadyOrdered&
- 1) THEN BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2
IF CGSortLibArr
(BsrchC&
) > CGSortLibArr
(NumberAlreadyOrdered&
) THEN Bsrcha& = BsrchC& + 1
BsrchB& = BsrchC&
InsertionBinaryB& = BsrchB&
InsertionBinaryB& = start&
SUB StableInvert
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, dorecurse&
) '* first invert then invert the equal elements
a& = start&
b& = finish&
SWAP CGSortLibArr
(a&
), CGSortLibArr
(b&
) a& = a& + 1
b& = b& - 1
'* then scan the array for runs of equal elements
p& = start&
y& = p& + 1
IF CGSortLibArr
(p&
) = CGSortLibArr
(y&
) THEN y& = y& + 1
StableInvert CGSortLibArr(), p&, y&, 0
p& = y&
'*****************************************
'* BucketSort (refactored)
'*****************************************
'*****************************************
'* BucketSort (modified 2018 march 14 (pi day 2018 to recurse), speeding things SIGNIFICANTLY.
'* by making a recursive single non-repeating call to BucketSort(), it speeds this up IMMENSELY. In fact, by 30 times.
'* From 10s down to 350ms, verified and correct, quite an improvement.
'* BucketSort() works by making fixed-size containers to hold ranges of elements. Much like Postman's Sort.
'* refactored to prevent inadvertent use of variables that MAY be present as constants or shared variables in MAIN.
'*****************************************
'* DIM BS_Local_ArrayRange AS DOUBLE
BSMMrec.min = start
BSMMrec.max = start
FOR x&
= tstart
TO finish
IF CGSortLibArr
(x&
) < CGSortLibArr
(BSMMrec.min
) THEN BSMMrec.min
= x&
IF CGSortLibArr
(x&
) > CGSortLibArr
(BSMMrec.max
) THEN BSMMrec.max
= x&
'* ------------------- GetMinMaxArray CGSortLibArr(), start, finish, BSMMrec
IF (CGSortLibArr
(BSMMrec.max
) - CGSortLibArr
(BSMMrec.min
)) <> 0 THEN '* BS_Local_ArrayRange = CGSortLibArr(BSMMrec.max) - CGSortLibArr(BSMMrec.min)
BS_Local_ArrayMinValue = CGSortLibArr(BSMMrec.min)
BS_Local_NBuckets
= INT(LOG(finish
- start
+ 1) / LOG(2)) + 1 BS_Local_N = (finish - start + 1)
BS_Local_Remainder
= BS_Local_N
MOD BS_Local_NBuckets
BS_Local_NBuckets = BS_Local_NBuckets - 1
REDIM BS_Buckets_CGSortLibArr
(0 TO BS_Local_NBuckets
, 0 TO BS_Local_NBuckets
* (1 + (BS_Local_N
- BS_Local_Remainder
) / BS_Local_NBuckets
)) AS DOUBLE FOR BS_Local_S
= start
TO finish
BS_Local_BucketIndex
= INT((BS_Local_NBuckets
- 1) * ((CGSortLibArr
(BS_Local_S
) - BS_Local_ArrayMinValue
) / (CGSortLibArr
(BSMMrec.max
) - CGSortLibArr
(BSMMrec.min
)))) 'IF BS_Count_CGSortLibArr(BS_Local_BucketIndex) > UBOUND(BS_Buckets_CGSortLibArr, 2) THEN
' REDIM _PRESERVE BS_Buckets_CGSortLibArr(BS_Local_BucketIndex, BS_Count_CGSortLibArr(BS_Local_BucketIndex)) AS DOUBLE
'END IF
BS_Buckets_CGSortLibArr(BS_Local_BucketIndex, BS_Count_CGSortLibArr(BS_Local_BucketIndex)) = CGSortLibArr(BS_Local_S)
BS_Count_CGSortLibArr(BS_Local_BucketIndex) = BS_Count_CGSortLibArr(BS_Local_BucketIndex) + 1
BS_Local_Last_Insert_Index = start
BS_Local_Current_Insert_Index = start
FOR BS_Local_S
= 0 TO BS_Local_NBuckets
IF BS_Count_CGSortLibArr
(BS_Local_S
) > 0 THEN BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
FOR BS_Local_Z
= 0 TO BS_Count_CGSortLibArr
(BS_Local_S
) - 1 CGSortLibArr(BS_Local_Current_Insert_Index) = BS_Buckets_CGSortLibArr(BS_Local_S, BS_Local_Z)
BS_Local_Current_Insert_Index = BS_Local_Current_Insert_Index + 1
'* Without this, 28s+ at (0, 131071)
recurse% = 0
BucketSort CGSortLibArr(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&, recurse%
MergeSortEmerge CGSortLibArr(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&
ERASE BS_Buckets_CGSortLibArr
, BS_Count_CGSortLibArr
'* adapted for use with qb64. This method is roughly 20 percent more efficient than the standard vector scan algorithm for min/max
'* Roughly 6.19s versus 7.93 for n=134217728 (0 counts as 1, of course)
'* This may be a nice addition for perhaps _CGArrayMax() in qb64. Of course, I am not so vain as to insist about the CG part.
'* simply meant as a faster tool for a common array problem to be solved. Also adaptable to string types.
'SUB GetMinMaxArray (CGSortLibArr() AS DOUBLE, Start&, Finish&, GetMinMaxArray_minmax AS MinMaxRec)
' DIM GetGetMinMaxArray_minmaxArray_i AS LONG
' DIM GetMinMaxArray_n AS LONG
' DIM GetMinMaxArray_TT AS LONG
' DIM GetMinMaxArray_NMod2 AS INTEGER
' '* this is a workaround for the irritating malfunction
' '* of MOD using larger numbers and small divisors
' GetMinMaxArray_n = Finish& - Start&
' GetMinMaxArray_TT = GetMinMaxArray_n MOD 10000
' GetMinMaxArray_NMod2 = GetMinMaxArray_n - 10000 * ((GetMinMaxArray_n - GetMinMaxArray_TT) / 10000)
' IF (GetMinMaxArray_NMod2 MOD 2) THEN
' GetMinMaxArray_minmax.min = Start&
' GetMinMaxArray_minmax.max = Start&
' GetGetMinMaxArray_minmaxArray_i = Start& + 1
' ELSE
' IF CGSortLibArr(Start&) > CGSortLibArr(Finish&) THEN
' GetMinMaxArray_minmax.max = Start&
' GetMinMaxArray_minmax.min = Finish&
' ELSE
' GetMinMaxArray_minmax.min = Finish&
' GetMinMaxArray_minmax.max = Start&
' END IF
' GetGetMinMaxArray_minmaxArray_i = Start& + 2
' END IF
' WHILE GetGetMinMaxArray_minmaxArray_i < Finish&
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) THEN
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
' GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
' END IF
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
' GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i + 1
' END IF
' ELSE
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
' GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i + 1
' END IF
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
' GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
' END IF
' END IF
' GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
' WEND
'END SUB
'SUB GetMinMaxArray (CGSortLibArr() AS DOUBLE, Start&, Finish&, GetMinMaxArray_minmax AS MinMaxRec)
' DIM GetGetMinMaxArray_minmaxArray_i AS LONG
' SELECT CASE Finish& - Start&
' CASE IS < 31
' GetMinMaxArray_minmax.min = start
' GetMinMaxArray_minmax.max = start
' FOR GetGetMinMaxArray_minmaxArray_i = Start& TO Finish&
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
' NEXT
' CASE ELSE
' 'DIM GetGetMinMaxArray_minmaxArray_i AS LONG
' DIM GetMinMaxArray_n AS LONG
' DIM GetMinMaxArray_TT AS LONG
' DIM GetMinMaxArray_NMod2 AS INTEGER
' '* this is a workaround for the irritating malfunction
' '* of MOD using larger numbers and small divisors
' GetMinMaxArray_n = Finish& - Start&
' GetMinMaxArray_TT = GetMinMaxArray_n MOD 10000
' GetMinMaxArray_NMod2 = GetMinMaxArray_n - 10000 * ((GetMinMaxArray_n - GetMinMaxArray_TT) / 10000)
' IF (GetMinMaxArray_NMod2 MOD 2) THEN
' GetMinMaxArray_minmax.min = Start&
' GetMinMaxArray_minmax.max = Start&
' GetGetMinMaxArray_minmaxArray_i = Start& + 1
' ELSE
' IF CGSortLibArr(Start&) > CGSortLibArr(Finish&) THEN
' GetMinMaxArray_minmax.max = Start&
' GetMinMaxArray_minmax.min = Finish&
' ELSE
' GetMinMaxArray_minmax.min = Finish&
' GetMinMaxArray_minmax.max = Start&
' END IF
' GetGetMinMaxArray_minmaxArray_i = Start& + 2
' END IF
' WHILE GetGetMinMaxArray_minmaxArray_i < Finish&
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) THEN
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
' GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
' END IF
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
' GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i + 1
' END IF
' ELSE
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i + 1) > CGSortLibArr(GetMinMaxArray_minmax.max) THEN
' GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i + 1
' END IF
' IF CGSortLibArr(GetGetMinMaxArray_minmaxArray_i) < CGSortLibArr(GetMinMaxArray_minmax.min) THEN
' GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
' END IF
' END IF
' GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
' WEND
' END SELECT
'END SUB
SUB GetArrayMinmax
(a
() AS DOUBLE, start&
, finish&
, arec
AS MinMaxRec
) arec.min = start&
arec.max = start&
FOR GetArrayMinmax_u
= start&
+ 1 TO finish&
IF a
(GetArrayMinmax_u
) < a
(arec.min
) THEN arec.min
= GetArrayMinmax_u
IF a
(GetArrayMinmax_u
) > a
(arec.max
) THEN arec.max
= GetArrayMinmax_u
SUB GetMinMaxArray
(cg
() AS DOUBLE, start&
, finish&
, MinMaxArray
AS MinMaxRec
) 'DIM GetMinMaxArray_i AS LONG
'* this is a workaround for the irritating malfunction
'* of MOD using larger numbers and small divisors
GetMinMaxArray_n = finish& - start&
int10000& = (finish& - start&) \ 10000
GetMinMaxArray_NMod2 = (finish& - start&) - 10000 * int10000&
'* GetMinMaxArray_NMod2 = GetMinMaxArray_n - 10000 * ((GetMinMaxArray_n - GetMinMaxArray_TT) / 10000)
MinMaxArray.min = start&
MinMaxArray.max = start&
GetMinMaxArray_i = start& + 1
IF cg
(start&
) > cg
(finish&
) THEN MinMaxArray.max = start&
MinMaxArray.min = finish&
MinMaxArray.min = finish&
MinMaxArray.max = start&
GetMinMaxArray_i = start& + 2
WHILE GetMinMaxArray_i
< finish&
IF cg
(GetMinMaxArray_i
) > cg
(GetMinMaxArray_i
+ 1) THEN IF cg
(GetMinMaxArray_i
) > cg
(MinMaxArray.max
) THEN MinMaxArray.max = GetMinMaxArray_i
IF cg
(GetMinMaxArray_i
+ 1) < cg
(MinMaxArray.min
) THEN MinMaxArray.min = GetMinMaxArray_i + 1
IF cg
(GetMinMaxArray_i
+ 1) > cg
(MinMaxArray.max
) THEN MinMaxArray.max = GetMinMaxArray_i + 1
IF cg
(GetMinMaxArray_i
) < cg
(MinMaxArray.min
) THEN MinMaxArray.min = GetMinMaxArray_i
GetMinMaxArray_i = GetMinMaxArray_i + 2
GetArrayMinmax cg(), start&, finish&, MinMaxArray
SUB HeapSort
(CGSortLibArr
() AS DOUBLE, Start&
, Finish&
, order&
) FOR i&
= Start&
+ 1 TO Finish&
PercolateUp CGSortLibArr(), Start&, i&, order&
SWAP CGSortLibArr
(Start&
), CGSortLibArr
(i&
) PercolateDown CGSortLibArr(), Start&, i& - 1, order&
SUB PercolateDown
(CGSortLibArr
() AS DOUBLE, Start&
, MaxLevel&
, order&
) i& = Start&
'* Move the value in GetPixel&(Start&) down the heap until it has
'* reached its proper node (that is, until it is less than its parent
'* node or until it has reached MaxLevel&, the bottom of the current heap):
Child& = 2 * (i& - Start&) + Start& ' Get the subscript for the Child& node.
'* Reached the bottom of the heap, so exit this procedure:
'* If there are two Child nodes, find out which one is bigger:
ax& = Child& + 1
IF CGSortLibArr
(ax&
) > CGSortLibArr
(Child&
) THEN Child& = ax&
'* Move the value down if it is still not bigger than either one of
'* its Child&ren:
IF CGSortLibArr
(i&
) < CGSortLibArr
(Child&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(Child&
) i& = Child&
'* Otherwise, CGSortLibArr() has been restored to a heap from start& to MaxLevel&,
'* so exit:
'* If there are two Child nodes, find out which one is smaller:
ax& = Child& + 1
IF CGSortLibArr
(ax&
) < CGSortLibArr
(Child&
) THEN Child& = ax&
'* Move the value down if it is still not smaller than either one of
'* its Child&ren:
IF CGSortLibArr
(i&
) > CGSortLibArr
(Child&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(Child&
) i& = Child&
'* Otherwise, CGSortLibArr() has been restored to a heap from start& to MaxLevel&,
'* so exit:
SUB PercolateUp
(CGSortLibArr
() AS DOUBLE, Start&
, MaxLevel&
, order&
) i& = MaxLevel&
'* Move the value in CGSortLibArr(MaxLevel&) up the heap until it has
'* reached its proper node (that is, until it is greater than either
'* of its Child& nodes, or until it has reached 1, the top of the heap):
'* Get the subscript for the parent node.
Parent& = Start& + (i& - Start&) \ 2
'* The value at the current node is still bigger than the value at
'* its parent node, so swap these two array elements:
IF CGSortLibArr
(i&
) > CGSortLibArr
(Parent&
) THEN SWAP CGSortLibArr
(Parent&
), CGSortLibArr
(i&
) i& = Parent&
'* Otherwise, the element has reached its proper place in the heap,
'* so exit this procedure:
i& = MaxLevel&
'* Move the value in CGSortLibArr(MaxLevel&) up the heap until it has
'* reached its proper node (that is, until it is greater than either
'* of its Child& nodes, or until it has reached 1, the top of the heap):
'* Get the subscript for the parent node.
Parent& = Start& + (i& - Start&) \ 2
'* The value at the current node is still smaller than the value at
'* its parent node, so swap these two array elements:
IF CGSortLibArr
(i&
) < CGSortLibArr
(Parent&
) THEN SWAP CGSortLibArr
(Parent&
), CGSortLibArr
(i&
) i& = Parent&
'* Otherwise, the element has reached its proper place in the heap,
'* so exit this procedure:
'****************************************
'* The IntroSort() algorithm extended to QBxx because there is no qbxx-compatible code
'* The IntroSort algorithm extended to qb64 because i could find no pure qbxx code
'* 03Jun2017, by CodeGuy -- further mods for use in sorting library 03 Aug 2017
'* Introspective Sort (IntroSort) falls back to MergeSort after so many levels of
'* recursion and is good for highly redundant data (aka few unique)
'* for very short runs, it falls back to InsertionSort.
STATIC IntroSort_MaxRecurseLevel&
IntroSort_MaxRecurseLevel& = 15
IF IntroSort_start
< IntroSort_finish
THEN IF IntroSort_finish
- IntroSort_start
> 31 THEN IF IntroSort_level&
> IntroSort_MaxRecurseLevel&
THEN HeapSort CGSortLibArr(), IntroSort_start, IntroSort_finish, order&
IntroSort_level& = IntroSort_level& + 1
QuickSortIJ CGSortLibArr(), IntroSort_start, IntroSort_finish, IntroSort_i, IntroSort_J, order&
QuickSortIntrospective CGSortLibArr(), IntroSort_start, IntroSort_J, order&
QuickSortIntrospective CGSortLibArr(), IntroSort_i, IntroSort_finish, order&
IntroSort_level& = IntroSort_level& - 1
InsertionSort CGSortLibArr(), IntroSort_start, IntroSort_finish, order&
SUB QuickSortIJ
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, i&
, j&
, order&
) DIM Compare
AS DOUBLE '* MUST be the same type as CGSortLibArr() i& = start&
j& = finish&
Compare = CGSortLibArr(i& + (j& - i&) \ 2)
DO WHILE CGSortLibArr
(i&
) < Compare
i& = i& + 1
DO WHILE CGSortLibArr
(j&
) > Compare
j& = j& - 1
SWAP CGSortLibArr
(i&
), CGSortLibArr
(j&
) i& = i& + 1
j& = j& - 1
DO WHILE CGSortLibArr
(i&
) > Compare
i& = i& + 1
DO WHILE CGSortLibArr
(j&
) < Compare
j& = j& - 1
SWAP CGSortLibArr
(i&
), CGSortLibArr
(j&
) i& = i& + 1
j& = j& - 1
'*********************************
'* The Standard Merge Algorithm extended to ascending or descending order
'* same tactic as MergeSort, but only MergeSorts halves amd then merges, with o(NlogN) for each half with straight Merge
'* the benefit of this meOhod is not only faster completion but also a 50% reduction in array allocation and copying.
'* this approach can be used in pretty much any sort to yield a faster sort, including the already-fast FlashSort. I will
'* attempt a string version of FlashSort. It will be complex.
'*********************************
SUB MergeSortTwoWay
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) middle& = start& + (finish& - start&) \ 2
MergeSortEmerge CGSortLibArr(), start&, middle&, order&
MergeSortEmerge CGSortLibArr(), middle& + 1, finish&, order&
'IF order& = 1 THEN
' EfficientMerge CGSortLibArr(), start&, finish&, order&
'ELSE
' MergeRoutine CGSortLibArr(), start&, finish&, order&
'END IF
'**********************
'* Standardized Merge procedure. Assumes CGSortLibArr(start to middle), CGSortLibArr(middle+1 to finish) is already sorted on arrival.
'**********************
SUB MergeRoutine
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) length& = finish& - start&
middle& = start& + length& \ 2
temp(i&) = CGSortLibArr(start& + i&)
'* for refactoring purposes,
'* mptr& = 0
'* sptr& = middle& - start& + 1
'* could be omitted from the select case blocks and declared here instead. However, I am leaving them as is
'* so code between SELECT CASE conditional checks can simply be copied for a fully functioning merge.
mptr& = 0
sptr& = middle& - start& + 1
IF sptr&
<= finish&
- start&
THEN IF mptr&
<= middle&
- start&
THEN IF temp
(mptr&
) > temp
(sptr&
) THEN CGSortLibArr(i& + start&) = temp(sptr&)
sptr& = sptr& + 1
CGSortLibArr(i& + start&) = temp(mptr&)
mptr& = mptr& + 1
CGSortLibArr(i& + start&) = temp(sptr&)
sptr& = sptr& + 1
CGSortLibArr(i& + start&) = temp(mptr&)
mptr& = mptr& + 1
mptr& = 0
sptr& = middle& - start& + 1
IF sptr&
<= finish&
- start&
THEN IF mptr&
<= middle&
- start&
THEN '* i see what you did there -- change from
'* temp(mptr&) > temp(sptr&) to temp(sptr&) > temp(mptr&)
IF temp
(sptr&
) > temp
(mptr&
) THEN CGSortLibArr(i& + start&) = temp(sptr&)
sptr& = sptr& + 1
CGSortLibArr(i& + start&) = temp(mptr&)
mptr& = mptr& + 1
CGSortLibArr(i& + start&) = temp(sptr&)
sptr& = sptr& + 1
CGSortLibArr(i& + start&) = temp(mptr&)
mptr& = mptr& + 1
SequenceCheck& = start&
i& = start&
FOR j&
= start&
+ 1 TO finish&
IF CGSortLibArr
(j&
) > CGSortLibArr
(i&
) THEN i& = j& '
SequenceCheck& = j&
FOR j&
= start&
+ 1 TO finish&
IF CGSortLibArr
(j&
) < CGSortLibArr
(i&
) THEN i& = j& '
SequenceCheck& = j&
SequenceCheck& = finish&
'***************************************************************************
'* string-specific code
'***************************************************************************
SUB FlashString
(StrCGSortLibArr
() AS STRING, start&
, finish&
, order&
) REDIM FlashStringCGSortLibArr
(start&
TO finish&
) AS FlashRec
shift##(7) = 1
shift##(z%) = shift##(z% + 1) * 256
shift##(0) = 1
shift##(z%) = shift##(z% - 1) * 256
FOR s&
= start&
TO finish&
acc## = 0
zp% = z% + 1
p$
= MID$(StrCGSortLibArr
(s&
), zp%
, 1) acc##
= acc##
+ shift##
(z%
) * ASC(p$
) z% = zp%
FlashStringCGSortLibArr(s&).Number = acc##
FlashStringCGSortLibArr(s&).Index = s&
flashSORTType FlashStringCGSortLibArr(), start&, finish&, order&
SUB flashSORTType
(CGSortLibArr
() AS FlashRec
, start
AS LONG, finish
AS LONG, order&
) '* change these:
'* to the same type as the array being sorted
'* change these:
'* to long for qbxx as qbxx has no _unsigned types
'* the original ratio was .125 but i kept getting array bounds errors
MIndex
= (INT(.128 * (finish
- start
+ 1)) + 1) OR 2
'* change these:
'* to the appropriate type for the range being sorted (must match start, finish variables)
'* don't mess:
DIM FlashC1
AS DOUBLE '* for some reason does not work with _float '* with this. it needs to be a double at the very least but float gives this a far greater range
'* more than likely more range than is practical. but ya never know (change this to double for qbxx)
' sorts array A with finish elements by use of
' index vector FlashTrackL with MIndex elements, with MIndex ca. 0.125(finish-start).
' Translation of Karl-Dietrich Neubert's FlashSort
' algorithm into BASIC by Erdmann Hess.
' Generalized Numeric Version -- recoded by codeguy
'* This is the absolute quickest sorting algorithm I can find for numeric arrays. Unfortunately, generalizing this for
'* strings may require some work. sounds like a project to me. I have changed a couple things from the original,
'* namely that .125 has been changed to .128. It seems that after a few runs on randomized data, a subscript error
'* kept popping up. Traced it to FlashTrackL() and added a minor (about 2.4%) increase in the upper bound of FlashTrackL().
'* I suppose this could also be used for non-integer and non-string types as well.
REM =============== CLASS FORMATION
=================
ANMiN = CGSortLibArr(start)
MaxValueIndex = start
FOR FlashI
= start
TO finish
IF (CGSortLibArr
(FlashI
).Number
> CGSortLibArr
(MaxValueIndex
).Number
) THEN MaxValueIndex
= FlashI
IF (CGSortLibArr
(FlashI
).Number
< ANMiN.Number
) THEN ANMiN = CGSortLibArr(FlashI)
SWAP CGSortLibArr
(start
), CGSortLibArr
(FlashI
)
IF ANMiN.Number
= CGSortLibArr
(MaxValueIndex
).Number
THEN '* this is a monotonic sequence array and by definition is already sorted
FlashC1 = (MIndex - 1) / (CGSortLibArr(MaxValueIndex).Number - ANMiN.Number)
FOR FlashI
= start
+ 1 TO finish
KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashI
).Number
- ANMiN.Number
)) + 1 FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1
FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)
REM ==================== PERMUTATION
================ FlashNMove = 0
FlashJ = start + 1
KIndex = MIndex
FinishMinusOne = finish - 1
SWAP CGSortLibArr
(finish
), CGSortLibArr
(MaxValueIndex
) WHILE (FlashNMove
< FinishMinusOne
) WHILE (FlashJ
> FlashTrackL
(KIndex
)) FlashJ = FlashJ + 1
KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashJ
).Number
- ANMiN.Number
)) + 1 flash = CGSortLibArr(FlashJ)
IF (FlashJ
= (FlashTrackL
(KIndex
) + 1)) THEN IF FlashNMove
< (FinishMinusOne
) THEN KIndex
= INT(FlashC1
* (flash.Number
- ANMiN.Number
)) + 1 hold = CGSortLibArr(FlashTrackL(KIndex))
CGSortLibArr(FlashTrackL(KIndex)) = flash
flash = hold
FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1
FlashNMove = FlashNMove + 1
'================= Insertion Sort============
'* sort subranges
FOR FlashI
= FlashTrackL
(SIndex
) - 1 TO FlashTrackL
(SIndex
- 1) STEP -1 IF (CGSortLibArr
(FlashI
+ 1).Number
< CGSortLibArr
(FlashI
).Number
) THEN hold = CGSortLibArr(FlashI)
NextFlashJ = FlashI
FlashJ = NextFlashJ
IF FlashJ
< FlashTrackL
(SIndex
) THEN NextFlashJ = FlashJ + 1
IF (CGSortLibArr
(NextFlashJ
).Number
< hold.Number
) THEN SWAP CGSortLibArr
(FlashJ
), CGSortLibArr
(NextFlashJ
) CGSortLibArr(FlashJ) = hold
'* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.
FOR s&
= start&
TO finish&
SWAP StrCGSortLibArr
(s&
), StrCGSortLibArr
(CGSortLibArr
(s&
).Index
) FOR s&
= start&
TO finish&
- 1 FOR t&
= s&
+ 1 TO finish&
IF StrCGSortLibArr
(s&
) > StrCGSortLibArr
(s&
+ 1) THEN SWAP StrCGSortLibArr
(s&
), StrCGSortLibArr
(s&
+ 1) FlashI = start
FlashJ = finish
SWAP StrCGSortLibArr
(FlashI
), StrCGSortLibArr
(FlashJ
) FlashI = FlashI - 1
FlashJ = FlashJ - 1
primeGapSort2 CGSortLibArr(), start, start + (finish - start) \ 2, order&
primeGapSort2 CGSortLibArr(), start + (finish - start) \ 2 + 1, finish, order&
EfficientMerge CGSortLibArr(), start, finish, order&
'*******************
'* PrimeGapSort2 uses PrimeNumber&() function to calculate the prime number less than or equal to the gap
'* this is a variation of shellsort. This variation is thus far the fastest non-recursive, in-place sorting
'* algorithm. Invented by CodeGuy. Tested, proven and improved by CodeGuy and Zom-B.
'*******************
SUB primeGapSort2
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) gap& = (finish& - start& + 1)
FOR i&
= start&
TO finish&
- gap&
IF CGSortLibArr
(i&
) > CGSortLibArr
(i&
+ gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ gap&
) gap& = primeNumber&(gap& * 0.727)
InsertionSort CGSortLibArr(), start&, finish&, order&
gap& = (finish& - start& + 1)
FOR i&
= start&
TO finish&
- gap&
IF CGSortLibArr
(i&
) < CGSortLibArr
(i&
+ gap&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ gap&
) gap& = primeNumber&(gap& * 0.727)
InsertionSort CGSortLibArr(), start&, finish&, order&
' Find a prime number below a& (excluding 3 and 5)
'
' Notice that there is a:
' 59,9% chance for a single successive guess,
' 83,9% chance for a successive guess out of two guesses,
' 93,6% chance for a successive guess out of three guesses,
' 97,4% chance for a successive guess out of four guesses,
' 99,98% chance for a successive guess out of ten guesses...
'
' Worst bad luck over 10000 tested primes: 19 guesses.
STATIC pps%
() 'Previous Prime in Sequence. Contains about 59.9% of all primes modulo 30. '* wheel factorization by Zom-B
firstCall% = -1
' Map numbers from 0 to 29 to the next lower prime in the sequence {1,7,11,13,17,19,23,29}.
pps%(0) = -1: pps%(1) = -1 ' -1 = 29 (modulo 30)
pps%(2) = 1: pps%(3) = 1: pps%(4) = 1: pps%(5) = 1: pps%(6) = 1: pps%(7) = 1
pps%(8) = 7: pps%(9) = 7: pps%(10) = 7: pps%(11) = 7
pps%(12) = 11: pps%(13) = 11:
pps%(14) = 13: pps%(15) = 13: pps%(16) = 13: pps%(17) = 13
pps%(18) = 17: pps%(19) = 17
pps%(20) = 19: pps%(21) = 19: pps%(22) = 19: pps%(23) = 19
pps%(24) = 23: pps%(25) = 23: pps%(26) = 23: pps%(27) = 23: pps%(28) = 23: pps%(29) = 23
addtoskip5%(0) = 2
addtoskip5%(1) = 4
addtoskip5%(2) = 2
addtoskip5%(3) = 2
b& = a& + 1
c& = (b& \ 30) * 30
b& = c& + pps%(b& - c&)
div& = 3
asi% = 1
div& = div& + addtoskip5%(asi%)
c& = (b& \ 30) * 30
b& = c& + pps%(b& - c&)
div& = 3
asi% = 1
primeNumber& = b&
'*******************
'* CombSort is the same as shellsort except a reduction factor of 1.3
'*******************
SUB CombSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) IF CGSortLibArr
(start&
) > CGSortLibArr
(finish&
) THEN SWAP CGSortLibArr
(start&
), CGSortLibArr
(finish&
) ShellSortGap&
= INT(10 * (finish&
- start&
) / 13) LoopCount& = 0
xstart& = start&
xfinish& = finish& - ShellSortGap&
MaxPasses& = (finish& - start&) \ ShellSortGap&
xfirst& = xfinish&
FOR ShellSortS&
= xstart&
TO xfinish&
IF CGSortLibArr
(ShellSortS&
) > CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) THEN SWAP CGSortLibArr
(ShellSortS&
), CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) Last& = ShellSortS&
xfirst& = ShellSortS&
xfinish& = Last&
xstart& = xfirst&
LoopCount& = LoopCount& + 1
LOOP WHILE LoopCount&
< MaxPasses&
AND (xfinish&
- xstart&
) >= ShellSortGap&
ShellSortGap&
= INT(10 * (ShellSortGap&
/ 13)) InsertionSort CGSortLibArr(), start&, finish&, order&
ShellSortGap&
= INT(10 * (finish&
- start&
) / 13) LoopCount& = 0
xstart& = start&
xfinish& = finish& - ShellSortGap&
MaxPasses& = (finish& - start&) \ ShellSortGap&
xfirst& = xfinish&
FOR ShellSortS&
= xstart&
TO xfinish&
IF CGSortLibArr
(ShellSortS&
) < CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) THEN SWAP CGSortLibArr
(ShellSortS&
), CGSortLibArr
(ShellSortS&
+ ShellSortGap&
) Last& = ShellSortS&
xfirst& = ShellSortS&
xfinish& = Last&
xstart& = xfirst&
LoopCount& = LoopCount& + 1
LOOP WHILE LoopCount&
< MaxPasses&
AND (xfinish&
- xstart&
) >= ShellSortGap&
ShellSortGap&
= INT(10 * (ShellSortGap&
/ 13)) InsertionSort CGSortLibArr(), start&, finish&, order&
'********************************
'* EfficientMerge, developed from StackOverflow, a horribly short description of the procedure.
'* Uses n/2 auxiliary array for a 50% memory reduction used in merging and similar reduction in
'* time-consuming array copying. Very handly when memory and time is limited.
'* assumes the array passed has already been sorted. Like all other algorithms, this may be
'* used recursively. However for the purpose of MergeSort, it is used as a helper procedure.
'* corrected to use the corresponding EfficientMerge method for both ascending and descending order.
'* provides performance symmetry regardless of sortation order. I will leave MergeRoutine as it is
'* proven stable, even if it is not as fast as EfficientMerge.
'********************************
SUB EfficientMerge
(right
() AS DOUBLE, start&
, finish&
, order&
) half& = start& + (finish& - start&) \ 2
REDIM left
(start&
TO half&
) AS DOUBLE '* hold the first half of the array in left() -- must be the same type as right() FOR LoadLeft&
= start&
TO half&
left(LoadLeft&) = right(LoadLeft&)
i& = start&
j& = half& + 1
insert& = start&
IF i&
> half&
THEN '* left() exhausted IF j&
> finish&
THEN '* right() exhausted '* stuff remains in right to be inserted, so flush right()
right(insert&) = right(j&)
j& = j& + 1
insert& = insert& + 1
'* and exit
right(insert&) = left(i&)
i& = i& + 1
insert& = insert& + 1
right(insert&) = right(j&)
j& = j& + 1
right(insert&) = left(i&)
i& = i& + 1
insert& = insert& + 1
i& = start&
j& = half& + 1
insert& = start&
IF i&
> half&
THEN '* left() exhausted IF j&
> finish&
THEN '* right() exhausted '* stuff remains in right to be inserted, so flush right()
right(insert&) = right(j&)
j& = j& + 1
insert& = insert& + 1
'* and exit
right(insert&) = left(i&)
i& = i& + 1
insert& = insert& + 1
right(insert&) = right(j&)
j& = j& + 1
right(insert&) = left(i&)
i& = i& + 1
insert& = insert& + 1
'**********************
'* SelectionSort, another o(n^2) sort. generally used only for very short lists. total comparisons is N(N+1)/2,
'* regardless of the state of sortation, making this only slightly better than bubblesort. This version is stable
'* Both the stable and unstable variants are VERY slow for large N aka (finish-start)
'* [s+][i+]{n^2 ]
'**********************
SUB SelectionSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) FOR s&
= start&
TO finish&
- 1 u& = s&
FOR t&
= s&
+ 1 TO finish&
IF CGSortLibArr
(t&
) < CGSortLibArr
(u&
) THEN u& = t&
SWAP CGSortLibArr
(s&
), CGSortLibArr
(u&
) FOR s&
= start&
TO finish&
- 1 u& = s&
FOR t&
= s&
+ 1 TO finish&
IF CGSortLibArr
(t&
) > CGSortLibArr
(u&
) THEN u& = t&
SWAP CGSortLibArr
(s&
), CGSortLibArr
(u&
)
'*************************
'* On repetitive arrays, SelectionSortUnstable penalizes both slow reads and writes.
'* neither stable nor unstable SelectionSort is recommended. It is not adaptive,
'* performing n(n+1)/2 operations regardless of the state of sortation.
'*************************
'* [s-][i+][n^2 ]
'* these MUST match the numeric type of start and finish
'*******************************************************
FOR SelectionSortUnstableQ
= start&
TO finish&
- 1 FOR SelectionSortUnstableR
= SelectionSortUnstableQ
+ 1 TO finish&
IF CgSortLibArr
(SelectionSortUnstableR
) < CgSortLibArr
(SelectionSortUnstableQ
) THEN SWAP CgSortLibArr
(SelectionSortUnstableR
), CgSortLibArr
(SelectionSortUnstableQ
) FOR SelectionSortUnstableQ
= start&
TO finish&
- 1 FOR r&
= SelectionSortUnstableQ
+ 1 TO finish&
IF CgSortLibArr
(SelectionSortUnstableR
) > CgSortLibArr
(SelectionSortUnstableQ
) THEN SWAP CgSortLibArr
(SelectionSortUnstableR
), CgSortLibArr
(SelectionSortUnstableQ
)
'********************
'* are writes to memory or disk time-consuming? this algorithm sorts and minimizes writes
'* complexity class: O(n^2)
'********************
SUB cycleSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) length& = finish& - start&
DIM item
AS DOUBLE '* MUST be same size and/or type as CGSortLibArr() element '* DIM writes AS LONG
' scan CGSortLibArr() for cycles to rotate
FOR cycleStart&
= start&
TO finish&
- 1 item = CGSortLibArr(cycleStart&)
'* find where to put the item
position& = cycleStart&
IF CGSortLibArr
(i&
) < item
THEN position&
= position&
+ 1 IF CGSortLibArr
(i&
) > item
THEN position&
= position&
+ 1 '* If the item is already in its correct position, this is not a cycle
IF position&
<> cycleStart&
THEN
'* Otherwise, put the item there or right after any duplicates
WHILE item
= CGSortLibArr
(position&
) position& = position& + 1
SWAP CGSortLibArr
(position&
), item
'* writes=writes+1
'rotate the rest of the cycle
WHILE position&
<> cycleStart&
'* Find where to put the item
position& = cycleStart&
IF CGSortLibArr
(i&
) < item
THEN position&
= position&
+ 1 IF CGSortLibArr
(i&
) > item
THEN position&
= position&
+ 1 ' Put the item there or right after any duplicates
WHILE item
= CGSortLibArr
(position&
) position& = position& + 1
SWAP CGSortLibArr
(position&
), item
'* writes=writes+1
'**********************
'* this is dl shell's sort but modified for faster running time than standard shellsort.
'**********************
SUB shellSortMetzner
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) m& = Metzner&(start&, finish&)
FOR j&
= start&
TO finish&
- m&
l& = j& + m&
b = CGSortLibArr(l&)
SWAP CGSortLibArr
(i&
+ m&
), CGSortLibArr
(i&
) l& = i&
i& = start&
CGSortLibArr(l&) = b
m& = (m& - 1) \ 3
m& = Metzner&(start&, finish&)
FOR j&
= start&
TO finish&
- m&
l& = j& + m&
b = CGSortLibArr(l&)
SWAP CGSortLibArr
(i&
+ m&
), CGSortLibArr
(i&
) l& = i&
i& = start&
CGSortLibArr(l&) = b
m& = (m& - 1) \ 3
x& = (b& - a& + 1) \ 3
s& = 0
s& = 3 * s& + 1
x& = (x& - 1) \ 3
Metzner& = s&
'*********************************
'* generates the Primes() table used by PrimeGapSort()
'* PrimeGapsSort2 uses wheel factoring to find primes.
'* I guess I could have used a Sieve of Eratosthenes too
'* But trial division is fast enough.
'*********************************
SUB PrimeGen
(Primes
() AS LONG, MaximumN&
, NPrimes&
) '* used correctly, this array will eliminate all integers of the form 10k and 10k+5 when added in sequence,
'* resulting in in integers ending in 1,3,7 or 9, saving 20% compute time versus blindly adding 2 each time.
addtoskip5(0) = 2
addtoskip5(1) = 4
addtoskip5(2) = 2
addtoskip5(3) = 2
Primes(0) = 2
s& = 1
r& = 2
p& = 0
NPrimes& = 1
s& = s& + addtoskip5(p&)
div& = 3
r& = 1
'* this is a prime
Primes(NPrimes&) = s&
NPrimes& = NPrimes& + 1
div& = div& + addtoskip5(r&)
NeedPrimes% = 0
'************************
'* the original invention by CodeGuy.
'* competitive time to MergeSort
'************************
SUB PrimeGapSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) PrimeGen Primes(), finish& - start& + 1, Nprimes&
Gap& = finish& - start&
b& = Nprimes&
t&
= INT(727 * (Gap&
/ 1000)) c& = a& + (b& - a&) \ 2
b& = c& - 1
a& = c&
b& = c& - 1
Gap& = Primes(c&)
FOR s&
= start&
TO finish&
- Gap&
IF CGSortLibArr
(s&
) > CGSortLibArr
(s&
+ Gap&
) THEN SWAP CGSortLibArr
(s&
), CGSortLibArr
(s&
+ Gap&
) Gap& = finish& - start&
b& = Nprimes&
t&
= INT(727 * (Gap&
/ 1000)) c& = a& + (b& - a&) \ 2
b& = c& - 1
a& = c&
b& = c& - 1
Gap& = Primes(c&)
FOR s&
= start&
TO finish&
- Gap&
IF CGSortLibArr
(s&
) < CGSortLibArr
(s&
+ Gap&
) THEN SWAP CGSortLibArr
(s&
), CGSortLibArr
(s&
+ Gap&
) InsertionSort CGSortLibArr(), start&, finish&, order&
'*****************
'* as long as a stable subsorting algorithm is used, PostSort remains stable.
'* Surprisingly as NumPostBins& increases, the speed increases.
'*****************
SUB PostSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) '* surprisngly, PostSort in this variation performs MORE slowly with increasing NumPostBins&.
'* not certain why, but that is the result.
GetMinMaxArray CGSortLibArr(), start&, finish&, PSMMrec
IF CGSortLibArr
(PSMMrec.min
) = CGSortLibArr
(PSMMrec.max
) THEN EXIT SUB NumPostBins& = 7
ps&
= 2 * INT((finish&
- start&
+ 1) / (NumPostBins&
+ 1)) Range# = CGSortLibArr(PSMMrec.max) - CGSortLibArr(PSMMrec.min)
FOR s&
= start&
TO finish&
Bin& = NthPlace&(CGSortLibArr(), PSMMrec, 0, NumPostBins&, order&, s&)
PostCGSortLibArr(Bin&, Counts(Bin&)) = CGSortLibArr(s&)
Counts(Bin&) = Counts(Bin&) + 1
TotalInserted& = start&
FOR a&
= 0 TO NumPostBins&
lastinsert& = Totalnserted&
FOR q&
= 0 TO Counts
(a&
) - 1 CGSortLibArr(TotalInserted&) = PostCGSortLibArr(a&, q&)
TotalInserted& = TotalInserted& + 1
MergeSortEmerge CGSortLibArr(), lastinsert&, TotalInserted& - 1, order&
'******************************************
'* I make no claims this is the fastest overall sort. In some cases, HashLisSort EASILY wins.
'* flashSort struggles with high repetition. HashListSort does not and actually performs better
'* when this is the case.
'* Yes, this is MY invention, by CodeGuy. Faster than FlashSort and relatively simple.
'* It involves an array roughly 25% bigger than the original array,
'* Yes, you read that Correctly, faster than FlashSort, even with a final InsertionSort.
'* Can also be used in place of CountingSort as it keeps track of repetitions (counts > 1).
'* 09 AUG 2017. 8388608 DOUBLE-precision elements sorted in about 10.95s (actually, a bit less),
'* versus 11.80s for FlashSort. 25% faster than FlashSort at N=16777216.
'* designed for arrays with high repetition (integer, or not) with minor, easy changes
'* to data types). HashListSort also outperforms FlashSort and DualPivotQuicksort
'* in this case, beating FlashSort by an (10-15)% margin, sometimes even higher.
'******************************************
GetMinMaxArray CGSortLibArr(), Start, Finish, Mrec
IF CGSortLibArr
(Mrec.min
) = CGSortLibArr
(Mrec.max
) THEN HLSDelta = CGSortLibArr(Mrec.max) - CGSortLibArr(Mrec.min)
MinValueInArray = CGSortLibArr(Mrec.min)
HLSHashProbe
= primeNumber&
(2 * INT(1.25#
* (Finish
- Start
) / 2) - 1) FOR HLS_S
= Start
TO Finish
HLS_F
= INT(HLSHashProbe
* (CGSortLibArr
(HLS_S
) - MinValueInArray
) / HLSDelta
) HLS_F = HLS_F - HLSHashProbe
HLS_F = HLS_F + HLSHashProbe
IF HashTable
(HLS_F
) = CGSortLibArr
(HLS_S
) THEN Count(HLS_F) = Count(HLS_F) + 1
HashTable(HLS_F) = CGSortLibArr(HLS_S)
Count(HLS_F) = 1
HLS_F = HLS_F + 1
HLS_NInserted = Start
FOR HLS_S
= 0 TO HLSHashProbe
CGSortLibArr(HLS_NInserted) = HashTable(HLS_S)
HLS_NInserted = HLS_NInserted + 1
Count(HLS_S) = Count(HLS_S) - 1
CGSortLibArr(HLS_NInserted) = HashTable(HLS_S)
HLS_NInserted = HLS_NInserted + 1
Count(HLS_S) = Count(HLS_S) - 1
'* use when you KNOW the data is narrow range
'* BubbleSortModified CGSortLibArr(), Start, Finish, order&
'* otherwise, this one is plenty fast for general purpose.
'InsertionSortBinary CGSortLibArr(), Start, Finish, order&
'* InsertionSort wins.
InsertionSort CGSortLibArr(), Start, Finish, order&
'*****************
'* It is rumored RadixSort is fast. In some cases, yes. BUT it is stable and for integer-domain numbers, it is quite suitable. It requires auxiliary
'* storage, so it is not an in-place algorithm.
'*****************
SUB RadixSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) ArrayIsInteger CGSortLibArr(), start&, finish&, errindex&, errcon&
'* use another stable sort and sort anyway
MergeSortEmerge CGSortLibArr(), start&, finish&, order&
GetMinMaxArray CGSortLibArr(), start&, finish&, RSMMrec
IF CGSortLibArr
(RSMMrec.min
) = CGSortLibArr
(RSMMrec.max
) THEN EXIT SUB '* no div0 bombs delta# = CGSortLibArr(RSMMrec.max) - CGSortLibArr(RSMMrec.min)
pow2 = Int64MaxShift
bits&
= LEN(Int64MaxShift
) * 8 FOR i&
= start&
TO finish&
NtmpN = Int64MaxShift * (CGSortLibArr(i&) - CGSortLibArr(RSMMrec.min)) / (delta#)
tmpradix% = 1
tmpradix% = 0
RadixCGSortLibArr(tmpradix%, ct&(tmpradix%)) = CGSortLibArr(i&)
ct&(tmpradix%) = ct&(tmpradix%) + 1
c& = start&
FOR j&
= 0 TO ct&
(i&
) - 1 CGSortLibArr(c&) = RadixCGSortLibArr(i&, j&)
c& = c& + 1
ct&(i&) = 0
pow2 = pow2 / 2
bits& = bits& - 1
pow2 = 1
FOR i&
= start&
TO finish&
NtmpN = Int64MaxShift * (CGSortLibArr(i&) - CGSortLibArr(RSMMrec.min)) / (delta#)
tmpradix% = 1
tmpradix% = 0
RadixCGSortLibArr(tmpradix%, ct&(tmpradix%)) = CGSortLibArr(i&)
ct&(tmpradix%) = ct&(tmpradix%) + 1
c& = start&
FOR j&
= 0 TO ct&
(i&
) - 1 CGSortLibArr(c&) = RadixCGSortLibArr(i&, j&)
c& = c& + 1
ct&(i&) = 0
pow2 = pow2 * 2
ERASE RadixCGSortLibArr
, ct&
'*****************
'* Used by RadixSort, which requires integer-domain arrays to function properly
'*****************
SUB ArrayIsInteger
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, errorindex&
, IsInt&
) IsInt& = 1
errorindex& = start&
FOR IsIntegerS&
= start&
TO finish&
errorindex& = IsIntegerS&
IsInt& = 0
'*****************
SUB BatcherOddEvenMergeSort
(CGSortLibArr
() AS DOUBLE, Start&
, Finish&
, order&
) m&
= (Finish&
+ (Finish&
MOD 2)) \
2 BatcherOddEvenMergeSort CGSortLibArr(), Start&, m&, order&
BatcherOddEvenMergeSort CGSortLibArr(), Start& + m&, m&, order&
BatcheroddEvenMerge CGSortLibArr(), Start&, Finish&, 1, order&
SUB BatcheroddEvenMerge
(CGSortLibArr
() AS DOUBLE, Start&
, Finish&
, r&
, order&
) m& = r& * 2
BatcheroddEvenMerge CGSortLibArr(), Start&, Finish&, m&, order&
BatcheroddEvenMerge CGSortLibArr(), Start& + r&, Finish&, m&, order&
i& = Start& + r&
IF i&
+ m&
> Start&
+ Finish&
THEN IF CGSortLibArr
(i&
) > CGSortLibArr
(i&
+ r&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ r&
) IF CGSortLibArr
(i&
) < CGSortLibArr
(i&
+ r&
) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(i&
+ r&
) i& = i& + m&
IF CGSortLibArr
(Start&
) > CGSortLibArr
(Start&
+ r&
) THEN SWAP CGSortLibArr
(Start&
), CGSortLibArr
(Start&
+ r&
) IF CGSortLibArr
(Start&
) < CGSortLibArr
(Start&
+ r&
) THEN SWAP CGSortLibArr
(Start&
), CGSortLibArr
(Start&
+ r&
)
SUB SinglePassShellSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) Gap& = (finish& - start&)
FOR c&
= start&
TO finish&
- Gap&
IF CGSortLibArr
(c&
) > CGSortLibArr
(c&
+ Gap&
) THEN SWAP CGSortLibArr
(c&
), CGSortLibArr
(c&
+ Gap&
) FOR c&
= start&
TO finish&
- Gap&
IF CGSortLibArr
(c&
) < CGSortLibArr
(c&
+ Gap&
) THEN SWAP CGSortLibArr
(c&
), CGSortLibArr
(c&
+ Gap&
) Gap&
= INT(Gap&
/ 1.247#
) InsertionSort CGSortLibArr(), start&, finish&, order&
'*********************
'* Another one of Kenneth Batcher's cool parallel sorting algorithms, also O(NLogN) classification complexity. I think the actual complexity
'* involves more Logs and such. Batcher Odd-Even MergeSort is also part of the parallel processing arsenal found on GPU-assisted parallel
'* processing algorithms. Donald Knuth speaks highly of it and correctly claims it can sort more items than there are on all the world's
'* computers. Corrected to use dir& = 1 for ascending
'*********************
SUB BitonicSort
(CGSortLibArr
() AS DOUBLE, lo&
, n&
, dir&
) m& = n& \ 2
BitonicSort CGSortLibArr(), lo&, m&, 1
BitonicSort CGSortLibArr(), lo&, m&, -1
BitonicSort CGSortLibArr(), lo& + m&, n& - m&, dir&
BitonicMerge CGSortLibArr(), lo&, n&, dir&
SUB BitonicMerge
(CGSortLibArr
() AS DOUBLE, lo&
, n&
, dir&
) m& = greatestPowerOfTwoLessThan&(n&)
FOR i&
= lo&
TO lo&
+ n&
- m&
BitonicMergeCompare CGSortLibArr(), i&, i& + m&, dir&
BitonicMerge CGSortLibArr(), lo&, m&, dir&
BitonicMerge CGSortLibArr(), lo& + m&, n& - m&, dir&
SUB BitonicMergeCompare
(CGSortLibArr
() AS DOUBLE, i&
, j&
, dir&
) IF (dir&
= SGN(CGSortLibArr
(i&
) - CGSortLibArr
(j&
))) THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(j&
)
FUNCTION greatestPowerOfTwoLessThan&
(n&
) k& = 1
k& = k& * 2
greatestPowerOfTwoLessThan& = k& / 2
'***********************
'* Kth order statistic for CGSortLibArr()
'* this algorithm also modifies the passed array
'**********************
SUB QuickSelectRecursive
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, statistic&
) PivotIndex = QSelectPartitionArray&(CGSortLibArr(), start&, finish&)
QuickSelectRecursive CGSortLibArr(), PivotIndex&, finish&, statistic&
QuickSelectRecursive CGSortLibArr(), start&, PivotIndex&, statistic&
'* this declaration of pivot MUST be the same type as CGSortLibArr()
pivotIndex&
= start&
+ RND * (finish&
- start&
) pivot = CGSortLibArr(pivotIndex&)
'* and a familiar shuffle routine reminiscent of QuickSort
SWAP CGSortLibArr
(pivotIndex&
), CGSortLibArr
(finish&
) pivotIndex& = start&
FOR i&
= start&
TO finish&
IF CGSortLibArr
(i&
) < pivot
THEN SWAP CGSortLibArr
(i&
), CGSortLibArr
(pivotIndex&
) pivotIndex& = pivotIndex& + 1
SWAP CGSortLibArr
(pivotIndex&
), CGSortLibArr
(finish&
) QSelectPartitionArray& = pivotIndex&
SUB QuickselectIterative
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, k&
) LStart& = start&
LFinish& = finish&
pivotindex = QSelectPartitionArray&(CGSortLibArr(), LStart&, LFinish&)
pivotindex& = QSelectPartitionArray&(CGSortLibArr(), LStart&, LFinish&)
LStart& = pivotindex
LFinish& = pivotindex
'* adapted for use with qb64. This method is roughly 20 percent more efficient than the standard vector scan algorithm for min/max
'* Roughly 6.19s versus 7.93 for n=134217728 (0 counts as 1, of course)
'* This may be a nice addition for perhaps _CGArrayMax() in qb64. Of course, I am not so vain as to insist about the CG part.
'* simply meant as a faster tool for a common array problem to be solved. Also adaptable to string types.
'* returns indexes instead of TYPE structure (not used in this library, but pretty much same as GetminMaxCGSortLibArr().
SUB ArrayGetMinMax
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, ArrayMinIndex&
, ArrayMaxIndex&
) n& = finish& - start&
ArrayMinIndex& = start&
ArrayMaxIndex& = start&
i& = 1
IF CGSortLibArr
(start&
) > CGSortLibArr
(finish&
) THEN ArrayMaxIndex& = start&
ArrayMinIndex& = start& + 1
ArrayMinIndex& = start&
ArrayMaxIndex& = start& + 1
i& = 2
IF (CGSortLibArr
(i&
) > CGSortLibArr
(i&
+ 1)) THEN IF CGSortLibArr
(i&
) > CGSortLibArr
(ArrayMaxIndex&
) THEN ArrayMaxIndex& = i&
IF CGSortLibArr
(i&
+ 1) < CGSortLibArr
(ArrayMinIndex&
) THEN ArrayMinIndex& = i& + 1
IF CGSortLibArr
(i&
+ 1) > CGSortLibArr
(ArrayMaxIndex&
) THEN ArrayMaxIndex& = i& + 1
IF CGSortLibArr
(i&
) < CGSortLibArr
(ArrayMinIndex&
) THEN ArrayMinIndex& = i&
i& = i& + 2
'******************
'* yields the pointer to an array element whose frequency of occurrence is greatest
'******************
FlashSort CGSortLibArr(), start&, finish&, 1
m& = 0
frequency& = 0
S& = start&
R& = S&
q& = R&
S& = S& + 1
IF CGSortLibArr
(R&
) = CGSortLibArr
(S&
) THEN
m& = q& - R&
modetemp& = R&
frequency& = m& + 1
Mode& = modetemp&
FlashSort CGSortLibArr(), start&, finish&, 1
'* There's an even number of elements in this subset -- think about it
'* then then median is calculated by the average of these 2 elements
p0& = IndexCenter&(start&, finish&)
p1& = p& + 1
ArrayMedian# = (CGSortLibArr(p0&) + CGSortLibArr(p1&)) / 2
'* there's an odd number of elements in this subset, so the ArrayMedian is the start+(finish-start-1)/2 element
ArrayMedian# = CGSortLibArr(IndexCenter&(start&, finish&))
t&
= (finish&
- start&
) MOD 2 '* if it's even, such as 1,5
'* it will be calculated as start&+(finish&-start&)/2
IndexCenter& = start& + (finish& - start&) / 2
'* otherwise, it will be calulated as start&+(finish&-start&-1)/2
IndexCenter& = start& + (finish& - start& - 1) / 2
IndexCenter& = start&
SUB SnakeSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) '* these MUST be the same type as start& and finish&
'***************************
'***************************
'*
'* these MUST be the same type as the array elements being sorted
'****************************
'****************************
L_MinInt = start&
L_MaxInt = finish&
REDIM L_Index
((L_MaxInt
- L_MinInt
+ 3) \
2) L_Index(0) = L_MinInt
i = L_MinInt
' Initial loop: locate cutoffs for each ordered section
i = i + 1
i = i + 1
i = i + 1
IF i
= L_MaxInt
THEN L_Direction
= 1 IF CGSortLibArr
(i
) > CGSortLibArr
(i
+ 1) THEN L_Direction = -1
L_Direction = 1
L_Level = L_Level + 1
L_Index(L_Level) = i * L_Direction
L_Direction = 0
i = i + 1
IF L_Direction
= 0 THEN L_Direction
= 1 L_Level = L_Level + 1
L_Index(L_Level) = i * L_Direction
' If the list is already sorted, exit
' If sorted descending, reverse before exiting
FOR i
= 0 TO (L_MaxInt
- L_MinInt
) \
2 SWAP CGSortLibArr
(L_MinInt
+ i
), CGSortLibArr
(L_MaxInt
- i
) '* varSwap = CGSortLibArr(L_MinInt + i)
'* CGSortLibArr(L_MinInt + i) = CGSortLibArr(L_MaxInt - i)
'* CGSortLibArr(L_MaxInt - i) = varSwap
'* Main loop - merge section pairs together until only one section left
REDIM ArrayAuxiliary
(L_MinInt
TO L_MaxInt
) AS DOUBLE '* must be same type as CGSortLibArr() L_OldLevel = L_Level
SnakeSortMerge ArrayAuxiliary(), L_Index(L_Level - 1), L_Index(L_Level), L_Index(L_Level + 1), CGSortLibArr(), order&
SnakeSortMerge CGSortLibArr(), L_Index(L_Level - 1), L_Index(L_Level), L_Index(L_Level + 1), ArrayAuxiliary(), order&
L_NewLevel = L_NewLevel + 1
L_Index
(L_NewLevel
) = ABS(L_Index
(L_Level
+ 1)) FOR i
= L_Index
(L_NewLevel
) + 1 TO L_MaxInt
CGSortLibArr(i) = ArrayAuxiliary(i)
FOR i
= L_Index
(L_NewLevel
) + 1 TO L_MaxInt
ArrayAuxiliary(i) = CGSortLibArr(i)
L_NewLevel = L_NewLevel + 1
L_Index(L_NewLevel) = L_Index(L_OldLevel)
L_Level = L_NewLevel
L_NewLevel = 0
blnMirror
= NOT blnMirror
'* Copy ArrayAuxiliary to CGSortLibArr() if necessary
FOR i
= L_MinInt
TO L_MaxInt
CGSortLibArr(i) = ArrayAuxiliary(i)
CGSortLibArr(i) = ArrayAuxiliary(i)
WHILE L_MinInt
< L_MaxInt
SWAP CGSortLibArr
(L_MinInt
), CGSortLibArr
(L_MaxInt
) L_MinInt = L_MinInt + 1
L_MaxInt = L_MaxInt - 1
DIM OutCount
AS LONG: OutCount
= 0 '* Do not assume OutCount is set to 0 IF pL_Left
<> 0 THEN OutCount
= ABS(pL_Left
) + 1 L_LMin = OutCount
LStep = 1
LMax = OutCount
LStep = -1
RStep = 1
RStep = -1
L_LeftPtr = L_LMin
L_RightPtr = L_RMin
IF L_LeftPtr
< pL_Left
OR L_LeftPtr
>= LMax
THEN IF L_RightPtr
> pL_Right
OR L_RightPtr
>= RMax
THEN
IF ArraySource
(L_LeftPtr
) <= ArraySource
(L_RightPtr
) THEN ArrayAuxiliary(OutCount) = ArraySource(L_LeftPtr)
FOR L_RightPtr
= L_RightPtr
TO RMax
STEP RStep
OutCount = OutCount + 1
ArrayAuxiliary(OutCount) = ArraySource(L_RightPtr)
L_LeftPtr = L_LeftPtr + LStep
ArrayAuxiliary(OutCount) = ArraySource(L_RightPtr)
OutCount = OutCount + 1
ArrayAuxiliary(OutCount) = ArraySource(L_LeftPtr)
L_RightPtr = L_RightPtr + RStep
OutCount = OutCount + 1
'******************************
'* from: http://www.vbforums.com/attachment.php?attachmentid=64242&d=1211306594
'* not really fast, but included because it works reasonably.
'******************************
SUB JoinSort
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
)
L_MinInt = start&
L_MaxInt = finish&
REDIM ArrayAuxiliary
(L_MinInt
TO L_MaxInt
) FOR i
= L_MinInt
TO L_MaxInt
jFirst = i
JStep = 0
FOR jLast
= i
TO L_MaxInt
- 1 IF CGSortLibArr
(jLast
) < CGSortLibArr
(jLast
+ 1) THEN ELSEIF CGSortLibArr
(jLast
) > CGSortLibArr
(jLast
+ 1) THEN L_Left = jFirst
kFirst = jLast + 1
FOR j
= 0 TO (jLast
- jFirst
) \
2 SWAP CGSortLibArr
(jFirst
+ j
), CGSortLibArr
(jLast
- j
) '* varSwap = CGSortLibArr(jFirst + j)
'* CGSortLibArr(jFirst + j) = CGSortLibArr(jLast - j)
'* CGSortLibArr(jLast - j) = varSwap
L_Right = jLast
L_Swap = jFirst
jFirst = jLast
jLast = L_Swap
JStep = 1
kStep = 0
FOR kLast
= kFirst
TO L_MaxInt
- 1 IF CGSortLibArr
(kLast
) < CGSortLibArr
(kLast
+ 1) THEN ELSEIF CGSortLibArr
(kLast
) > CGSortLibArr
(kLast
+ 1) THEN L_Right = kLast
L_Swap = kFirst
kFirst = kLast
kLast = L_Swap
kStep = 1
O = L_Left
j = jFirst
k = kFirst
IF CGSortLibArr
(j
) < CGSortLibArr
(k
) THEN ArrayAuxiliary(O) = CGSortLibArr(j)
O = O + 1
ArrayAuxiliary(O) = CGSortLibArr(k)
j = j + JStep
ArrayAuxiliary(O) = CGSortLibArr(k)
O = O + 1
ArrayAuxiliary(O) = CGSortLibArr(j)
k = k + kStep
O = O + 1
FOR O
= L_Left
TO L_Right
CGSortLibArr(O) = ArrayAuxiliary(O)
i = L_Right
L_MinInt = start&
L_MaxInt = finish&
WHILE L_MinInt
< L_MaxInt
SWAP CGSortLibArr
(L_MinInt
), CGSortLibArr
(L_MaxInt
) L_MinInt = L_MinInt + 1
L_MaxInt = L_MaxInt - 1
SUB QSortRecursiveSimplified
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) QSRi = start&
QSRj = finish&
PartitionVal
= CGSortLibArr
(start&
+ INT(RND * (finish&
- start&
))) WHILE (CGSortLibArr
(QSRi
) < PartitionVal
) QSRi = QSRi + 1
WHILE (CGSortLibArr
(QSRj
) > PartitionVal
) QSRj = QSRj - 1
SWAP CGSortLibArr
(QSRi
), CGSortLibArr
(QSRj
) QSRi = QSRi + 1
QSRj = QSRj - 1
WHILE (CGSortLibArr
(QSRi
) > PartitionVal
) QSRi = QSRi + 1
WHILE (CGSortLibArr
(QSRj
) < PartitionVal
) QSRj = QSRj - 1
SWAP CGSortLibArr
(QSRi
), CGSortLibArr
(QSRj
) QSRi = QSRi + 1
QSRj = QSRj - 1
QSortRecursiveSimplified CGSortLibArr(), start&, QSRj, order&
QSortRecursiveSimplified CGSortLibArr(), QSRi, finish&, order&
'********************
'* Djikstra SmoothSort converted from VB 2018Feb20 by CodeGuy
'* There is no BYVAL, in QB64, so I did a workaround
'*************************
SUB SmoothSort_TypedArray
(TypedCGSortLibArr
() AS DataElement
, order&
)
lngLeftRightTreeAddress = 1
lngSubTreeSize = 1
lngLeftSubTreeSize = 1
lngOneBasedIndex = 1
lngNodeIndex = 0
SmoothSift_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = (lngLeftRightTreeAddress + 1) \ 4
SmoothUp_TypedArray lngSubTreeSize, lngLeftSubTreeSize
SmoothUp_TypedArray lngSubTreeSize, lngLeftSubTreeSize
ELSEIF lngLeftRightTreeAddress
MOD 4 = 1 THEN 'This is always true if it gets here IF lngOneBasedIndex
+ lngLeftSubTreeSize
< UBOUND(TypedCGSortLibArr
) + 1 THEN SmoothSift_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
SmoothTrinkle_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2
LOOP WHILE lngSubTreeSize
<> 1 'Continue until we reach the bottom of the tree lngLeftRightTreeAddress = lngLeftRightTreeAddress + 1
lngOneBasedIndex = lngOneBasedIndex + 1
lngNodeIndex = lngNodeIndex + 1
SmoothTrinkle_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
lngOneBasedIndex = lngOneBasedIndex - 1
lngNodeIndex = lngNodeIndex - 1
lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
lngLeftRightTreeAddress = lngLeftRightTreeAddress / 2
SmoothUp_TypedArray lngSubTreeSize, lngLeftSubTreeSize
ELSEIF lngSubTreeSize
>= 3 THEN 'It must fall in here, sub trees are either size 1,1,3,5,9,15 etc lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
lngNodeIndex = lngNodeIndex + lngLeftSubTreeSize - lngSubTreeSize
IF lngLeftRightTreeAddress
<> 0 THEN SmoothSemiTrinkle_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2 + 1
lngNodeIndex = lngNodeIndex + lngLeftSubTreeSize
SmoothSemiTrinkle_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2 + 1
Restabilize_TypedArray TypedCGSortLibArr(), order&
SUB SmoothUp_TypedArray
(lngSubTreeSize
AS LONG, lngLeftSubTreeSize
AS LONG) sutemp = lngSubTreeSize + lngLeftSubTreeSize + 1
lngLeftSubTreeSize = lngSubTreeSize
lngSubTreeSize = sutemp
SUB SmoothDown_TypedArray
(lngSubTreeSize
AS LONG, lngLeftSubTreeSize
AS LONG) sdtemp = lngSubTreeSize - lngLeftSubTreeSize - 1
lngSubTreeSize = lngLeftSubTreeSize
lngLeftSubTreeSize = sdtemp
SUB SmoothSift_TypedArray
(TypedCGSortLibArr
() AS DataElement
, NodeIndex
AS LONG, SubTreeSize
AS LONG, LeftSubTreeSize
AS LONG) DIM lngNodeIndex
AS LONG: lngNodeIndex
= NodeIndex
DIM lngSubTreeSize
AS LONG: lngSubTreeSize
= SubTreeSize
DIM lngLeftSubTreeSize
AS LONG: lngLeftSubTreeSize
= LeftSubTreeSize
lngChildIndex = lngNodeIndex - lngSubTreeSize + lngLeftSubTreeSize
IF TypedCGSortLibArr
(lngChildIndex
).thekey
< TypedCGSortLibArr
(lngNodeIndex
- 1).thekey
THEN lngChildIndex = lngNodeIndex - 1
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
IF TypedCGSortLibArr
(lngNodeIndex
).thekey
>= TypedCGSortLibArr
(lngChildIndex
).thekey
THEN lngSubTreeSize = 1
Exchange_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngChildIndex
lngNodeIndex = lngChildIndex
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
SUB SmoothTrinkle_TypedArray
(TypedCGSortLibArr
() AS DataElement
, NodeIndex
AS LONG, LeftRightTreeAddress
AS LONG, SubTreeSize
AS LONG, LeftSubTreeSize
AS LONG) DIM lngNodeIndex
AS LONG: lngNodeIndex
= NodeIndex
DIM lngLeftRightTreeAddress
AS LONG: lngLeftRightTreeAddress
= LeftRightTreeAddress
DIM lngSubTreeSize
AS LONG: lngSubTreeSize
= SubTreeSize
DIM lngLeftSubTreeSize
AS LONG: lngLeftSubTreeSize
= LeftSubTreeSize
DO WHILE lngLeftRightTreeAddress
> 0 lngLeftRightTreeAddress = lngLeftRightTreeAddress \ 2
SmoothUp_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngPreviousCompleteTreeIndex = lngNodeIndex - lngSubTreeSize
IF lngLeftRightTreeAddress
= 1 THEN lngLeftRightTreeAddress = 0
ELSEIF TypedCGSortLibArr
(lngPreviousCompleteTreeIndex
).thekey
<= TypedCGSortLibArr
(lngNodeIndex
).thekey
THEN lngLeftRightTreeAddress = 0
lngLeftRightTreeAddress = lngLeftRightTreeAddress - 1
Exchange_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngPreviousCompleteTreeIndex
lngNodeIndex = lngPreviousCompleteTreeIndex
lngChildIndex = lngNodeIndex - lngSubTreeSize + lngLeftSubTreeSize
IF TypedCGSortLibArr
(lngChildIndex
).thekey
< TypedCGSortLibArr
(lngNodeIndex
- 1).thekey
THEN lngChildIndex = lngNodeIndex - 1
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = lngLeftRightTreeAddress * 2
IF TypedCGSortLibArr
(lngPreviousCompleteTreeIndex
).thekey
>= TypedCGSortLibArr
(lngChildIndex
).thekey
THEN Exchange_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngPreviousCompleteTreeIndex
lngNodeIndex = lngPreviousCompleteTreeIndex
Exchange_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngChildIndex
lngNodeIndex = lngChildIndex
SmoothDown_TypedArray lngSubTreeSize, lngLeftSubTreeSize
lngLeftRightTreeAddress = 0
SmoothSift_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngSubTreeSize, lngLeftSubTreeSize
SUB SmoothSemiTrinkle_TypedArray
(TypedCGSortLibArr
() AS DataElement
, NodeIndex
AS LONG, LeftRightTreeAddress
AS LONG, SubTreeSize
AS LONG, LeftSubTreeSize
AS LONG) DIM lngNodeIndex
AS LONG: lngNodeIndex
= NodeIndex
DIM lngLeftRightTreeAddress
AS LONG: lngLeftRightTreeAddress
= LeftRightTreeAddress
DIM lngSubTreeSize
AS LONG: lngSubTreeSize
= SubTreeSize
DIM lngLeftSubTreeSize
AS LONG: lngLeftSubTreeSize
= LeftSubTreeSize
lngIndexTopPreviousCompleteHeap = lngNodeIndex - lngLeftSubTreeSize
IF TypedCGSortLibArr
(lngIndexTopPreviousCompleteHeap
).thekey
> TypedCGSortLibArr
(lngNodeIndex
).thekey
THEN Exchange_TypedArray TypedCGSortLibArr(), lngNodeIndex, lngIndexTopPreviousCompleteHeap
SmoothTrinkle_TypedArray TypedCGSortLibArr(), lngIndexTopPreviousCompleteHeap, lngLeftRightTreeAddress, lngSubTreeSize, lngLeftSubTreeSize
SUB Exchange_TypedArray
(TypedCGSortLibArr
() AS DataElement
, plng1
AS LONG, plng2
AS LONG) IF TypedCGSortLibArr
(plng1
).thekey
<> TypedCGSortLibArr
(plng2
).thekey
THEN SWAP TypedCGSortLibArr
(plng1
), TypedCGSortLibArr
(plng2
) IF TypedCGSortLibArr
(plng1
).originalorder
> TypedCGSortLibArr
(plng2
).originalorder
THEN SWAP TypedCGSortLibArr
(plng1
), TypedCGSortLibArr
(plng2
)
SUB Restabilize_TypedArray
(TypedCGSortLibArr
() AS DataElement
, order&
) Rsa&
= LBOUND(TypedCGSortLibArr
) Rsb&
= UBOUND(TypedCGSortLibArr
) IF TypedCGSortLibArr
(Rsa&
).thekey
<> TypedCGSortLibArr
(Rsb&
).thekey
THEN SWAP TypedCGSortLibArr
(Rsa&
), TypedCGSortLibArr
(Rsb&
) Rsa& = Rsa& + 1
Rsb& = Rsb& - 1
q&
= LBOUND(TypedCGSortLibArr
) r& = q& + 1
IF TypedCGSortLibArr
(q&
).thekey
= TypedCGSortLibArr
(r&
).thekey
THEN r& = r& + 1
z& = r&
p& = r& - 1
r& = p& - 1
IF TypedCGSortLibArr
(r&
).originalorder
> TypedCGSortLibArr
(p&
).originalorder
THEN SWAP TypedCGSortLibArr
(r&
), TypedCGSortLibArr
(p&
) r& = p&
q& = z&
'*********************************
'* TESTED -- WORKS
'* This is the iterative version of QuickSort, using a software stack, useful for OLD processors lacking hardware registers
'* supporting recursion. Operationally, it is very much the same as the recursive version except the "stack" is software-based.
'* Similar performance to recursive quicksort. Uses Median-of-Three partition method, randomly selected pivot between low and high.
'**********************************
SUB QuickSortIterativeMedianOf3
(CGSortLibArr
() AS DOUBLE, Start&
, Finish&
, order&
) MinStack&
= 2 * LOG(Finish&
- Start&
+ 1) \
LOG(2) + 1 DIM LStack&
(MinStack&
, 1) StackPtr& = 0
LStack&(StackPtr&, 0) = Start&
LStack&(StackPtr&, 1) = Finish&
Low& = LStack&(StackPtr&, 0)
Hi& = LStack&(StackPtr&, 1)
i& = Low&
j& = Hi&
'* one more tactic to help defeat O(n^2) worst-case performance
'* pick a RANDOM pivot. Use of fixed pivot 1/2 distance from Low&+(hi&-low&)\2 MAY result in infinite loop
MedianOfThree CGSortLibArr(), Low&, Low& + (Hi& - Low&) \ 2, High&, MedianIndex&
compare = CGSortLibArr(MedianIndex&)
compare = CGSortLibArr(Low& + (Hi& - Low&) \ 2)
DO WHILE CGSortLibArr
(i&
) < compare
i& = i& + 1
DO WHILE CGSortLibArr
(j&
) > compare
j& = j& - 1
SWAP CGSortLibArr
(i&
), CGSortLibArr
(j&
) i& = i& + 1
j& = j& - 1
DO WHILE CGSortLibArr
(i&
) > compare
i& = i& + 1
DO WHILE CGSortLibArr
(j&
) < compare
j& = j& - 1
SWAP CGSortLibArr
(i&
), CGSortLibArr
(j&
) i& = i& + 1
j& = j& - 1
LStack&(StackPtr&, 0) = i&
LStack&(StackPtr&, 1) = Hi&
StackPtr& = StackPtr& + 1
Hi& = j&
LStack&(StackPtr&, 0) = Low&
LStack&(StackPtr&, 1) = j&
StackPtr& = StackPtr& + 1
Low& = i&
StackPtr& = StackPtr& - 1
'* For QuickSort using the median of three partitioning method. Used to defeat "QuickSort Killer" arrays.
IF CGSortLibArr
(MotA
) > CGSortLibArr
(MotB
) THEN IF CGSortLibArr
(MotA
) < CGSortLibArr
(MotC
) THEN MedianIndex = MotA
ELSEIF CGSortLibArr
(MotB
) > CGSortLibArr
(MotC
) THEN MedianIndex = MotB
MedianIndex = MotC
IF CGSortLibArr
(MotA
) > CGSortLibArr
(MotC
) THEN MedianIndex = MotA
ELSEIF CGSortLibArr
(MotB
) < CGSortLibArr
(MotC
) THEN MedianIndex = MotB
MedianIndex = MotC
'************************************************
'* This version of BubbleSort actually performs BETTER than InsertionSort for low entropy,
'* roughly twice as fast as standard BubbleSort.
'************************************************
SUB BubbleSortModified
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) BubbleSortModified_s = -1
BubbleSortModified_a = start&
BubbleSortModified_b = finish&
BubbleSortModified_SwapFirst = BubbleSortModified_a
BubbleSortModified_SwapLast = BubbleSortModified_b - 1
FOR BubbleSortModified_x
= BubbleSortModified_SwapFirst
TO BubbleSortModified_SwapLast
IF CGSortLibArr
(BubbleSortModified_x
) > CGSortLibArr
(BubbleSortModified_x
+ 1) THEN SWAP CGSortLibArr
(BubbleSortModified_x
), CGSortLibArr
(BubbleSortModified_x
+ 1) IF BubbleSortModified_x
< BubbleSortModified_b
THEN BubbleSortModified_b = BubbleSortModified_x
BubbleSortModified_a = BubbleSortModified_x
BubbleSortModified_s = 0
SWAP BubbleSortModified_a
, BubbleSortModified_b
LOOP WHILE BubbleSortModified_a
< BubbleSortModified_b
BubbleSortModified_s = -1
BubbleSortModified_a = start&
BubbleSortModified_b = finish&
BubbleSortModified_SwapFirst = BubbleSortModified_a
BubbleSortModified_SwapLast = BubbleSortModified_b - 1
FOR BubbleSortModified_x
= BubbleSortModified_SwapFirst
TO BubbleSortModified_SwapLast
IF CGSortLibArr
(BubbleSortModified_x
) < CGSortLibArr
(BubbleSortModified_x
+ 1) THEN SWAP CGSortLibArr
(BubbleSortModified_x
), CGSortLibArr
(BubbleSortModified_x
+ 1) IF BubbleSortModified_x
< BubbleSortModified_b
THEN BubbleSortModified_b = BubbleSortModified_x
BubbleSortModified_a = BubbleSortModified_x
BubbleSortModified_s = 0
SWAP BubbleSortModified_a
, BubbleSortModified_b
LOOP WHILE BubbleSortModified_a
< BubbleSortModified_b
'*****************************
'* MergeEfficient is essentially MergeSort, except it uses the EfficientMerge routine requiring only half the auxiliary.
'* Just here for comparison against the standard MergeSort. Yes, it is faster because there is less array copying.
'*******************************
MergeEfficientMiddle = start + (finish - start) \ 2
MergeSortEfficient CGSortLibArr(), start, MergeEfficientMiddle, order&
MergeSortEfficient CGSortLibArr(), MergeEfficientMiddle + 1, finish, order&
EfficientMerge CGSortLibArr(), start, finish, order&
'********************
'* approximately 4 times as fast as standard BubbleSort, making this algorithm less
'* computationally painful for larger unordered datasets.
'********************
m& = start + (finish - start) \ 2
BubbleSortModified CGSortLibArr(), start, m&, order&
BubbleSortModified CGSortLibArr(), m& + 1, finish, order&
EfficientMerge CGSortLibArr(), start, finish, order&
'**************************
'* approximately twice as fast as the original version for unordered datasets.
'**************************
SUB BubbleSortModified_0
(a
() AS DOUBLE, start&
, finish&
, order&
) s& = -1
a& = start&
b& = finish&
first& = a&
last& = b& - 1
b& = x&
a& = x&
s& = 0
s& = -1
a& = start&
b& = finish&
first& = a&
last& = b& - 1
b& = x&
a& = x&
s& = 0
'*******************************
'* KnuthShuffle, named for its progenitor, Donald Knuth, rearranges CGSortLibArr() in randomized order, swapping element
'* KnuthStart& and some element after it up to CGSortLibArr(finish&)
'*******************************
Randomindexintoarray
= KnuthStart
+ INT(RND * (finish
- KnuthStart
- 1)) SWAP CGSortLibArr
(KnuthStart
), CGSortLibArr
(Randomindexintoarray
) KnuthStart = KnuthStart + 1
FUNCTION ArraySequenceCheck&
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) oseq& = order&
h& = start&
i& = start&
IF CGSortLibArr
(i&
) < CGSortLibArr
(h&
) THEN '* this is a sequence error
oseq& = 0
oseq& = -1
h& = i&
'* this is also a sequence error
oseq& = 0
oseq& = 1
h& = i&
i& = i& + 1
ArraySequenceCheck& = (oseq& = order&)
DIM NPy
AS DOUBLE: NPy
= (a
(NPMMrec.max
) - a
(NPMMrec.min
)) Np&
= INT((NPx
* (finish
- start
)) \ NPy
) NthPlace& = start + Np&
NthPlace& = finish - Np&
'SUB BFPRT (CGSortLibArr() AS DOUBLE, start AS LONG, finish AS LONG, BFPRTMedian AS DOUBLE)
' bfprtn& = 5
' IF finish - start < bfprtn& - 1 THEN
' SELECT CASE (finish - start) MOD bfprtn&
' CASE 0, 2, 4
' BFPRTMedian = CGSortLibArr(start + (finish - start) \ 2)
' CASE 1
' BFPRTMedian = (CGSortLibArr(start) + CGSortLibArr(finish)) / 2
' CASE 3
' BFPRTMedian = (CGSortLibArr(start + 1) + CGSortLibArr(finish - 1)) / 2
' END SELECT
' FOR c& = start TO finish
' PRINT CGSortLibArr(c&); finish - start
' NEXT
' ELSE
' REDIM BfprtArray(0 TO (finish - start) / bfprtn& + bfprtn&) AS DOUBLE
' s& = LBOUND(CGSortLibArr)
' BfprtCount& = 0
' DO
' IF s& - 1 > finish - bfprtn& THEN
' InsertionSort CGSortLibArr(), s&, finish, 1
' DO UNTIL s& > finish
' BfprtArray(BfprtCount&) = CGSortLibArr(s&)
' s& = s& + 1
' LOOP
' EXIT DO
' ELSE
' InsertionSort CGSortLibArr(), s&, s& + bfprtn& - 1, 1
' BfprtArray(BfprtCount&) = CGSortLibArr(s& + (bfprtn& - 1) \ 2)
' '* PRINT BfprtArray(BfprtCount&); BfprtCount&
' BfprtCount& = BfprtCount& + 1
' s& = s& + bfprtn&
' END IF
' LOOP
' BFPRT BfprtArray(), 0, BfprtCount& - 1, BFPRTMedian
' END IF
'END SUB
'* Demo of 48828125 double-precision elements takes a shade over 10s on 2.16GHz machine, sometimes going low as 9.6s.
'* Blum, M.; Floyd, R. W.; Pratt, V. R.; Rivest, R. L.; Tarjan, R. E. (August 1973). "Time bounds for selection" (PDF).
'* Journal of Computer and System Sciences. 7 (4): 448–461. doi:10.1016/S0022-0000(73)80033-9.
'*******************************
''* Coded 25 Mar 2018 By CodeGuy
'*******************************
DIM BFPRT_SubdivisionSize
AS LONG: BFPRT_SubdivisionSize
= 5 IF finish
- start
< BFPRT_SubdivisionSize
- 1 THEN BFPRTMedian = CGSortLibArr(start + (finish - start) \ 2)
BFPRTMedian = (CGSortLibArr(start) + CGSortLibArr(finish)) / 2
BFPRTMedian = (CGSortLibArr(start + 1) + CGSortLibArr(finish - 1)) / 2
REDIM BfprtArray
(0 TO (finish
- start
) / BFPRT_SubdivisionSize
+ BFPRT_SubdivisionSize
) AS DOUBLE BFPRT_ScanIndexArray
= LBOUND(CGSortLibArr
) BFPRT_CountArrayIndex = 0
IF BFPRT_ScanIndexArray
- 1 > finish
- BFPRT_SubdivisionSize
THEN InsertionSort CGSortLibArr(), BFPRT_ScanIndexArray, finish, 1
DO UNTIL BFPRT_ScanIndexArray
> finish
BfprtArray(BFPRT_CountArrayIndex) = CGSortLibArr(BFPRT_ScanIndexArray)
BFPRT_ScanIndexArray = BFPRT_ScanIndexArray + 1
InsertionSort CGSortLibArr(), BFPRT_ScanIndexArray, BFPRT_ScanIndexArray + BFPRT_SubdivisionSize - 1, 1
BfprtArray(BFPRT_CountArrayIndex) = CGSortLibArr(BFPRT_ScanIndexArray + (BFPRT_SubdivisionSize - 1) \ 2)
'* PRINT BfprtArray(BFPRT_CountArrayIndex); BFPRT_CountArrayIndex
BFPRT_CountArrayIndex = BFPRT_CountArrayIndex + 1
BFPRT_ScanIndexArray = BFPRT_ScanIndexArray + BFPRT_SubdivisionSize
BFPRT BfprtArray(), 0, BFPRT_CountArrayIndex - 1, BFPRTMedian
'* used to defeat the "midnight bug."
DeltaTime! = (86400 - time1!) + time2!
DeltaTime! = time2! - time1!
SUB CGScaleArrayToInteger
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
, CGSortLibArr_mmrec
AS MinMaxRec
, CGSortLibArr_ScaleMultiplier
AS DOUBLE)
GetMinMaxArray CGSortLibArr(), start&, finish&, CGSortLibArr_mmrec
CGScaleArray_Range = CGSortLibArr(CGSortLibArr_mmrec.max) - CGSortLibArr(CGSortLibArr_mmrec.min)
IF CGScaleArray_Range
<> 0 THEN CGScaleArray_ScaleTemp = CGScaleArray_Range
CGScaleArray_ScaleTemp = CGSortLibArr(CGSortLibArr_mmrec.min)
CGScaleArray_Range = 1
CGScaleArray_PowerOf2 = 0
DO UNTIL CGScaleArray_ScaleTemp
= INT(CGScaleArray_ScaleTemp
) CGScaleArray_ScaleTemp = CGScaleArray_ScaleTemp * 2
CGScaleArray_PowerOf2 = CGScaleArray_PowerOf2 + 1
CGSortLibArr_ScaleMultiplier = 2 ^ CGScaleArray_PowerOf2
SUB CGFrequencyCounts
(CGSortLibArr
() AS DOUBLE, Start&
, Finish&
, order&
, CGSortLibArr_mmrec
AS MinMaxRec
, CGSortLibArr_ScaleMultiplier
AS DOUBLE) '* a short example of using this multiplier to convert the range respresented by
'* CGSortLibArr(start&) -> CGSortLibArr(finish&)
'* to a scaled integer: the lowest valued element will appear as 0.
FOR CGFrequencyCounts_IteratorU
= Start&
TO Finish&
CGFrequencyCounts_Index = NthPlace&(CGSortLibArr(), CGSortLibArr_mmrec, Start&, Finish&, order&, CGFrequencyCounts_IteratorU)
'CGFrequencyCounts_Index = INT((CGSortLibArr(CGFrequencyCounts_IteratorU) - CGSortLibArr(CGSortLibArr_mmrec.min)) * (Finish& - Start&) / (CGSortLibArr(CGSortLibArr_mmrec.max) - CGSortLibArr(CGSortLibArr_mmrec.min)))
CGFrequencyCounts_Array(CGFrequencyCounts_rank) = CGFrequencyCounts_Array(CGFrequencyCounts_rank) + 1
'* this was for profiling purposes and short demo
'IF CGFrequencyCounts_IteratorU MOD 37 = 0 THEN
' LOCATE (CGFrequencyCounts_IteratorU MOD DisplayRows) + 1, 1
' PRINT USING "i=#,###,###,###,###"; CGFrequencyCounts_Index;
' PRINT USING "r=#,###,###,###,###"; CGFrequencyCounts_rank;
' PRINT USING "s=#################"; CGFrequencyCounts_x * CGSortLibArr_ScaleMultiplier;
' PRINT USING "t(###,###,###,###)="; CGFrequencyCounts_IteratorU;
' PRINT USING "###################"; CGSortLibArr(CGFrequencyCounts_IteratorU) * CGSortLibArr_ScaleMultiplier;
' PRINT USING "c=#,###,####,###,###"; CGFrequencyCounts_Array(CGFrequencyCounts_rank);
'END IF
IF CGFrequencyCounts_Array
(stx&
) > 0 THEN b#
= CGSortLibArr
(CGSortLibArr_mmrec.min
) + (CGSortLibArr
(CGSortLibArr_mmrec.max
) - CGSortLibArr
(CGSortLibArr_mmrec.min
)) * (stx&
/ UBOUND(CGFrequencyCounts_Array
)) 'PRINT "{"; b#; ","; CGFrequencyCounts_Array(stx&); "}";
ERASE CGFrequencyCounts_Array
CGSetSortLibArrDelta = minimum - maximum
CGSetSortLibArrDelta = maximum - minimum
CGSetSortLibArrDelta = CGSetSortLibArrDelta / (finish& - start& + 1)
MontonicValue#
= mimumum
+ RND * (maximum
- minimum
) FOR s&
= start&
TO finish&
CGSortLibArr(s&) = maximum - (s& - start&) * CGSetSortLibArrDelta
CGSortLibArr
(s&
) = minimum
+ RND * (maximum
- minimum
) CGSortLibArr(s&) = minimum + (s& - start&) * CGSetSortLibArrDelta
m& = start& + (finish& - start&) \ 2
CGSortLibArr(s&) = maximum - (s& - m&) * CGSetSortLibArrDelta
CGSortLibArr(s&) = minimum + (s& - start&) * CGSetSortLibArrDelta
CGSortLibArr(s&) = MontonicValue#
ScaleArrayToInt CGSortLibArr(), start&, finish&
SUB ScaleArrayToInt
(CGSortLibArr
() AS DOUBLE, start&
, finish&
) DIM satimmrec
AS MinMaxRec
GetMinMaxArray CGSortLibArr(), start&, finish&, satimmrec
IF CGSortLibArr
(satimmrec.min
) <> 0 THEN sati_T = CGSortLibArr(satimmrec.min)
sati_T = CGSortLibArr(satimmrec.max)
sati_m = 1
sati_m = sati_m * 10
sati_T = sati_T * 10
FOR s&
= start&
TO finish&
CGSortLibArr(s&) = CGSortLibArr(s&) * sati_m
SUB BitInvert
(C
() AS DOUBLE, start&
, finish&
, method&
) '* Method
'* 0 simply bit-inverts bits in an element of CGSortLibArr(), one by one
'* 1 Inverts the elements of CGSortLibArr()
'* 2 bit-inverts elements of CGSortLibArr()
'// C++ program to perform TimSort.
'#include<bits/stdc++.h>
'using namespace std;
'const int RUN = 32;
'// this function sorts array from left index to
'// to right index which is of size atmost RUN
'void insertionSort(int arr[], int left, int right)
'{
' for (int i = left + 1; i <= right; i++)
' {
' int temp = arr[i];
' int j = i - 1;
' while (arr[j] > temp && j >= left)
' {
' arr[j+1] = arr[j];
' j--;
' }
' arr[j+1] = temp;
' }
'}
'// merge function merges the sorted runs
'void merge(int arr[], int l, int m, int r)
'{
' // original array is broken in two parts
' // left and right array
' int len1 = m - l + 1, len2 = r - m;
' int left[len1], right[len2];
' for (int i = 0; i < len1; i++)
' left[i] = arr[l + i];
' for (int i = 0; i < len2; i++)
' right[i] = arr[m + 1 + i];
' int i = 0;
' int j = 0;
' int k = l;
' // after comparing, we merge those two array
' // in larger sub array
' while (i < len1 && j < len2)
' {
' if (left[i] <= right[j])
' {
' arr[k] = left[i];
' i++;
' }
' else
' {
' arr[k] = right[j];
' j++;
' }
' k++;
' }
' // copy remaining elements of left, if any
' while (i < len1)
' {
' arr[k] = left[i];
' k++;
' i++;
' }
' // copy remaining element of right, if any
' while (j < len2)
' {
' arr[k] = right[j];
' k++;
' j++;
' }
'}
'// iterative Timsort function to sort the
'// array[0...n-1] (similar to merge sort)
'void timSort(int arr[], int n)
'{
' // Sort individual subarrays of size RUN
' for (int i = 0; i < n; i+=RUN)
' insertionSort(arr, i, min((i+31), (n-1)));
' // start merging from size RUN (or 32). It will merge
' // to form size 64, then 128, 256 and so on ....
' for (int size = RUN; size < n; size = 2*size)
' {
' // pick starting point of left sub array. We
' // are going to merge arr[left..left+size-1]
' // and arr[left+size, left+2*size-1]
' // After every merge, we increase left by 2*size
' for (int left = 0; left < n; left += 2*size)
' {
' // find ending point of left sub array
' // mid+1 is starting point of right sub array
' int mid = left + size - 1;
' int right = min((left + 2*size - 1), (n-1));
' // merge sub array arr[left.....mid] &
' // arr[mid+1....right]
' merge(arr, left, mid, right);
' }
' }
'}
'// utility function to print the Array
'void printArray(int arr[], int n)
'{
' for (int i = 0; i < n; i++)
' printf("%d ", arr[i]);
' printf("\n");
'}
'// Driver program to test above function
'int main()
'{
' int arr[] = {5, 21, 7, 23, 19};
' int n = sizeof(arr)/sizeof(arr[0]);
' printf("Given Array is\n");
' printArray(arr, n);
' timSort(arr, n);
' printf("After Sorting Array is\n");
' printArray(arr, n);
' return 0;
'}
'* Give CodeGuy some props.
primeGapSort2 array_a(), array_a_start, array_a_finish, 1
primeGapSort2 array_b(), array_b_start, array_b_finish, 1
inserted_in_UI
= LBOUND(UIArray
) start_a = array_a_start
Start_b = array_b_start
IF start_a
> array_a_finish
THEN WHILE Start_b
<= array_b_finish
UIArray(inserted_in_UI) = array_b(Start_b)
inserted_in_UI = inserted_in_UI + 1
Start_b = Start_b + 1
WHILE start_a
<= array_a_finish
UIArray(inserted_in_UI) = array_a(start_a)
inserted_in_UI = inserted_in_UI + 1
start_a = start_a + 1
IF array_b
(Start_b
) < array_a
(start_a
) THEN UIArray(inserted_in_UI) = array_b(Start_b)
Start_b = Start_b + 1
UIArray(inserted_in_UI) = array_a(start_a)
start_a = start_a + 1
inserted_in_UI = inserted_in_UI + 1
'* binary search is fine for this operation too
'* intersection finds elements common to array_a() and array_b()
'* elements common to both arrays are inserted into UIArray()
IF start_a
> array_a_finish
THEN IF Start_b
> array_b_finish
THEN IF array_a
(start_a
) = array_b
(Start_b
) THEN UIArray(inserted_in_UI) = array_a(start_a)
inserted_in_UI = inserted_in_UI + 1
start_a = start_a + 1
Start_b = Start_b + 1
Start_b = Start_b + 1
start_a = start_a + 1
'**************************************
'* anyone claiming you need c/c++ to implement trees is telling you CRAP
'* This is a bit more complex than the standard non-copying version, but it is still
'* respectably fast. General complexity for TreeSort() is O(NLogN), EXCEPT when
'* presented with elements already sorted. One way to avoid this is to KnuthShuffle
'* the input first. Skipped in this implementation, but there is no reason you
'* can't do it prior to TreeSort(). Code modified/added from my repository. This
'* version allows multiple same-value nodes
'* Modified/added 26 March 2018.
'**************************************
SUB TreeSortUsingBST
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, order&
) DIM TSAmmrec
AS MinMaxRec
GetMinMaxArray CGSortLibArr(), start&, finish&, TSAmmrec
delta# = CGSortLibArr(TSAmmrec.max) - CGSortLibArr(TSAmmrec.min)
IF delta#
= 0 THEN 'already sorted because they're all equal NilValue&
= LBOUND(CGSortLibArr
) - 1 DIM tree
(start&
+ 1 TO finish&
+ 1) AS TreeNode
FOR x&
= start&
+ 1 TO finish&
+ 1 tree(x&).value = 0
tree(x&).left = NilValue&
tree(x&).right = NilValue&
tree(1).value = CGSortLibArr(1 - 1)
free& = 2
pointer& = 1
IF CGSortLibArr
(x&
- 1) < tree
(pointer&
).value
THEN IF tree
(pointer&
).left
= NilValue&
THEN tree(pointer&).left = free&
tree(free&).value = CGSortLibArr(x& - 1)
free& = free& + 1
pointer& = tree(pointer&).left
IF tree
(pointer&
).right
= NilValue&
THEN tree(pointer&).right = free&
tree(free&).value = CGSortLibArr(x& - 1)
free& = free& + 1
pointer& = tree(pointer&).right
pointer& = 1
IF CGSortLibArr
(x&
- 1) > tree
(pointer&
).value
THEN IF tree
(pointer&
).left
= NilValue&
THEN tree(pointer&).left = free&
tree(free&).value = CGSortLibArr(x& - 1)
free& = free& + 1
pointer& = tree(pointer&).left
IF tree
(pointer&
).right
= NilValue&
THEN tree(pointer&).right = free&
tree(free&).value = CGSortLibArr(x& - 1)
free& = free& + 1
pointer& = tree(pointer&).right
depth& = start& + 1
Traverse_tree CGSortLibArr(), start& + 1, depth&, tree(), NilValue&
SUB Traverse_tree
(CGSortLibArr
() AS DOUBLE, NextPtr&
, depth&
, tree
() AS TreeNode
, NilValue&
) IF tree
(NextPtr&
).left
<> NilValue&
THEN Traverse_tree CGSortLibArr(), tree(NextPtr&).left, depth&, tree(), NilValue&
CGSortLibArr(depth& - 1) = tree(NextPtr&).value
depth& = depth& + 1
IF tree
(NextPtr&
).right
<> NilValue&
THEN Traverse_tree CGSortLibArr
(), tree
(NextPtr&
).right
, depth&
, tree
(), NilValue&
'* normopt& = 0 normalizes range (0,,1) inclusive
'* normopt& = 1 returns minimum NVT_ScaleMultiplier that multiplied by each element returns a whole (non-decimal) number
SUB NormalizeVectorTo
(CGSortLibArr
() AS DOUBLE, start&
, finish&
, NormOpt&
, NVT_ScaleMultiplier
AS DOUBLE) DIM NormalizeVectorTo_minmax
AS MinMaxRec
NVT_ScaleMultiplier = 1
GetMinMaxArray CGSortLibArr(), start&, finish&, NormalizeVectorTo_minmax: NVT_Minimum = CGSortLibArr(NormalizeVectorTo_minmax.min)
IF CGSortLibArr
(NormalizeVectorTo_minmax.min
) < CGSortLibArr
(NormalizeVectorTo_minmax.max
) THEN NVT_ScaleMultiplier = CGSortLibArr(NormalizeVectorTo_minmax.max) - CGSortLibArr(NormalizeVectorTo_minmax.min)
FOR s&
= start&
TO finish&
CGSortLibArr(s&) = (CGSortLibArr(s&) - NVT_Minimum) / NVT_ScaleMultiplier#
'*************************
IF CGSortLibArr
(NormalizeVectorTo_minmax.min
) <> 0 THEN NVT_ScaleMultiplier = CGSortLibArr(NormalizeVectorTo_minmax.min)
IF CGSortLibArr
(NormalizeVectorTo_minmax.max
) <> 0 THEN NVT_ScaleMultiplier = CGSortLibArr(NormalizeVectorTo_minmax.max)
DO UNTIL NVT_ScaleMultiplier
= INT(NVT_ScaleMultiplier
) NVT_ScaleMultiplier = NVT_ScaleMultiplier * 2
'* monotonic
IF CGSortLibArr
(start&
) <> 0 THEN FOR s&
= start&
TO finish&
CGSortLibArr(s&) = 1
NVT_ScaleMultiplier = CGSortLibArr(start&)
'* assumes CGBI_element_d >=0
'* returns CGBI_element_d as bit-inverted version of CGBI_element_d
ui64_shift(0) = 1
FOR cgbi_s
= 1 TO LEN(ui64_shift
(0)) * 8 - 1 ui64_shift(cgbi_s) = ui64_shift(cgbi_s - 1) * 2
CGBI_ShiftTable% = -1
CGBI_BitsInElement
= LEN(CGBI_element_d
) * 8 - 1 IF CGBI_element_d
> ui64_shift
(CGBI_element_s
) THEN CGBI_element_s = CGBI_element_s - 1
CGBI_element_d = CGBI_element_d + ui64_shift(CGBI_element_s)
CGBI_element_r = CGBI_element_r + ui64_shift(CGBI_element_s)
IF CGBI_element_d
< ui64_shift
(cgb_element_s
) THEN CGBI_element_s = CGBI_element_s - 1
CGBI_element_d = CGBI_element_d - ui64_shift(CGBI_BitsInElement - CGBI_element_s)
CGBI_element_r = CGBI_element_r + uinsi64_shift(CGBI_BitsInElement - CGBI_element_s)
CGBI_element_d = CGBI_element_r
p% = 0
p% = p% + 1
x = x * 10
CGBitInvert_element x
'*********************
'* Timsort, slightly modified and highly simplified
'* O(NLogN) complexity and at 8388608 elements in 24s make this a good, fast stable sort.
'*********************
IF finish
- start
< minrun
THEN InsertionSortBinary CGSortLibArr(), start, finish, order&
DIM TimSort_Local_size
AS LONG: TimSort_Local_size
= minrun
FOR TimSort_Local_i
= start
TO finish
- minrun
+ 1 STEP minrun
InsertionSortBinary CGSortLibArr(), TimSort_Local_i, TimSort_Local_i + minrun - 1, order&
IF TimSort_Local_i
< finish
THEN InsertionSortBinary CGSortLibArr(), TimSort_Local_i, finish, order&
TimSort_local_left = start
TimSort_local_mid = TimSort_local_left + TimSort_Local_size - 1
IF TimSort_local_mid
+ TimSort_Local_size
> finish
- TimSort_Local_size
THEN Tim_merge CGSortLibArr(), TimSort_local_left, TimSort_local_mid, finish, order&
TimSort_local_right = TimSort_local_mid + TimSort_Local_size
Tim_merge CGSortLibArr(), TimSort_local_left, TimSort_local_mid, TimSort_local_right, order&
TimSort_local_left = TimSort_local_left + 2 * TimSort_Local_size
TimSort_local_mid = TimSort_local_left + TimSort_Local_size - 1
TimSort_Local_size = TimSort_Local_size * 2
LOOP UNTIL start
+ TimSort_Local_size
> finish
Tim_Merge_LenLeft = middle - left + 1
Tim_Merge_LenRight = right - middle
'* load up left side (lower half in left) (start ... middle)
FOR Tim_Merge_i
= 0 TO Tim_Merge_LenLeft
- 1 array_left(Tim_Merge_i) = CGSortLibArr(left + Tim_Merge_i)
'* load up right side (upper half in left) (middle + 1 ... finish)
FOR Tim_Merge_i
= 0 TO Tim_Merge_LenRight
- 1 array_right(Tim_Merge_i) = CGSortLibArr(middle + Tim_Merge_i + 1)
Tim_Merge_i = 0
Tim_Merge_J = 0
Tim_Merge_k = left
WHILE (Tim_Merge_i
< Tim_Merge_LenLeft
AND Tim_Merge_J
< Tim_Merge_LenRight
) IF (array_left
(Tim_Merge_i
) <= array_right
(Tim_Merge_J
)) THEN CGSortLibArr(Tim_Merge_k) = array_left(Tim_Merge_i)
Tim_Merge_i = Tim_Merge_i + 1
CGSortLibArr(Tim_Merge_k) = array_right(Tim_Merge_J)
Tim_Merge_J = Tim_Merge_J + 1
Tim_Merge_k = Tim_Merge_k + 1
WHILE (Tim_Merge_i
< Tim_Merge_LenLeft
AND Tim_Merge_J
< Tim_Merge_LenRight
) IF (array_left
(Tim_Merge_i
) >= array_right
(Tim_Merge_J
)) THEN CGSortLibArr(Tim_Merge_k) = array_left(Tim_Merge_i)
Tim_Merge_i = Tim_Merge_i + 1
CGSortLibArr(Tim_Merge_k) = array_right(Tim_Merge_J)
Tim_Merge_J = Tim_Merge_J + 1
Tim_Merge_k = Tim_Merge_k + 1
WHILE (Tim_Merge_i
< Tim_Merge_LenLeft
) CGSortLibArr(Tim_Merge_k) = array_left(Tim_Merge_i)
Tim_Merge_k = Tim_Merge_k + 1
Tim_Merge_i = Tim_Merge_i + 1
WHILE (Tim_Merge_J
< Tim_Merge_LenRight
) CGSortLibArr(Tim_Merge_k) = array_right(Tim_Merge_J)
Tim_Merge_k = Tim_Merge_k + 1
Tim_Merge_J = Tim_Merge_J + 1
'SUB GnomeSort (array() AS DOUBLE, start AS LONG, finish AS LONG, order&)
' '* LOCATE 40, 1: PRINT USING "#####.################"; TIMER(.001);
' DIM GnomeSort_I AS LONG
' SELECT CASE order&
' CASE 1
' GnomeSort_I = start + 1
' DO UNTIL GnomeSort_I > finish
' IF (array(GnomeSort_I - 1) <= array(GnomeSort_I)) THEN
' GnomeSort_I = GnomeSort_I + 1
' ELSE
' SWAP array(GnomeSort_I), array(GnomeSort_I - 1)
' GnomeSort_I = GnomeSort_I - 1
' IF (GnomeSort_I < start + 1) THEN
' GnomeSort_I = start + 1
' END IF
' END IF
' LOOP
' CASE ELSE
' GnomeSort_I = start + 1
' DO UNTIL GnomeSort_I > finish
' IF (array(GnomeSort_I - 1) >= array(GnomeSort_I)) THEN
' GnomeSort_I = GnomeSort_I + 1
' ELSE
' SWAP array(GnomeSort_I), array(GnomeSort_I - 1)
' GnomeSort_I = GnomeSort_I - 1
' IF (GnomeSort_I < start + 1) THEN
' GnomeSort_I = start + 1
' END IF
' END IF
' LOOP
' END SELECT
' '* LOCATE 40, 1: PRINT USING "#####.################"; TIMER(.001);
'END SUB
Gnome_i = start + 1
Gnome_j = Gnome_i + 1
WHILE (Gnome_i
< finish
- start
) IF CGSortLibArray
(Gnome_i
- 1) <= CGSortLibArray
(Gnome_i
) THEN Gnome_i = Gnome_j
Gnome_j = Gnome_j + 1
SWAP CGSortLibArray
(Gnome_i
- 1), CGSortLibArray
(Gnome_i
) Gnome_i = Gnome_i - 1
Gnome_i = Gnome_j
Gnome_j = Gnome_j + 1
Gnome_i = start + 1
Gnome_j = Gnome_i + 1
WHILE (Gnome_i
< finish
- start
) IF CGSortLibArray
(Gnome_i
- 1) >= CGSortLibArray
(Gnome_i
) THEN Gnome_i = Gnome_j
Gnome_j = Gnome_j + 1
SWAP CGSortLibArray
(Gnome_i
- 1), CGSortLibArray
(Gnome_i
) Gnome_i = Gnome_i - 1
Gnome_i = Gnome_j
Gnome_j = Gnome_j + 1
'SUB CountingSort (CGSortLibArray() AS DOUBLE, start AS LONG, finish AS LONG, order&)
' DIM CSmmrec AS MinMaxRec
' GetMinMaxArray CGSortLibArray(), start, finish, CSmmrec
' DIM pow2_shift AS DOUBLE: pow2_shift = 1
' DIM XInsert AS LONG: XInsert = 0
' IF CGSortLibArray(CSmmrec.min) <> CGSortLibArray(CSmmrec.max) THEN
' ArrayIsInteger CGSortLibArray(), start, finish, ErrIndex&, IsIntegers&
' IF IsIntegers& THEN
' '* no scaling needed
' IF start = LBOUND(CGSortLibArray) THEN
' IF finish = UBOUND(CGSortLibArray) THEN
' redimc& = -1
' ELSE
' redimc& = 0
' END IF
' ELSE
' redimc& = 0
' END IF
' IF redimc& THEN
' REDIM Counts(0 TO CGSortLibArray(CSmmrec.max) - CGSortLibArray(CSmmrec.min)) AS LONG
' FOR scanarrayp& = start TO finish
' Counts(CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min)) = Counts(CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min)) + 1
' NEXT
' IF order& = 1 THEN
' XInsert = start
' FOR scanarrayp& = LBOUND(counts) TO UBOUND(counts)
' IF Counts(scanarrayp&) > 0 THEN
' FOR u& = 0 TO Counts(scanarrayp&) - 1
' CGSortLibArray(XInsert) = scanarrayp& + CGSortLibArray(CSmmrec.min)
' XInsert = XInsert + 1
' NEXT
' END IF
' NEXT
' ELSE
' XInsert = finish
' FOR scanarrayp& = UBOUND(counts) TO LBOUND(counts) STEP -1
' IF Counts(scanarrayp&) > 0 THEN
' FOR u& = Counts(scanarrayp&) - 1 TO 0 STEP -1
' CGSortLibArray(XInsert) = scanarrayp& + CGSortLibArray(CSmmrec.min)
' XInsert = XInsert - 1
' NEXT
' END IF
' NEXT
' END IF
' FOR x& = start TO finish
' PRINT CGSortLibArray(x&);
' NEXT
' ELSE
' FOR scanarrayp& = start TO finish
' Counts(CGSortLibArray(scanarrayp&) - MinArray) = Counts(CGSortLibArray(scanarrayp&) - MinArray) + 1
' NEXT
' FOR scanarrayp& = LBOUND(counts) TO UBOUND(counts)
' FOR u& = 0 TO Counts(scanarrayp&) - 1
' CGSortLibArray(XInsert) = scanarrayp& + MinArray
' XInsert = XInsert + 1
' NEXT
' '* REDIM _PRESERVE Counts(scanarrayp& TO finish) AS LONG
' NEXT
' END IF
' '* clear the Counts() array
' ERASE Counts
' ELSE
' DIM t AS DOUBLE
' IF CGSortLibArray(CSmmrec.min) <> 0 THEN
' t = CGSortLibArray(CSmmrec.min)
' ELSE
' t = CGSortLibArray(CSmmrec.max)
' END IF
' POW2_SHIFT& = 1
' DO UNTIL t = INT(t)
' t = t * 2
' pow2_shift = pow2_shift * 2
' LOOP
' REDIM Counts(0 TO pow2_shift * (CGSortLibArray(CSmmrec.max) - CGSortLibArray(CSmmrec.min)))
' FOR scanarrayp& = start TO finish
' x& = pow2_shift * (CGSortLibArray(scanarray&) - MinArray)
' Counts(x&) = Counts(x&) + 1
' NEXT
' IF order& = 1 THEN
' FOR scanarrayp& = LBOUND(counts) TO UBOUND(counts)
' FOR u& = 0 TO Counts(scanarrayp&) - 1
' CGSortLibArray(XInsert) = scanarrayp& + MinArray
' XInsert = XInsert + 1
' NEXT
' '* REDIM _PRESERVE Counts(scanarrayp& TO finish) AS LONG
' NEXT
' ELSE
' FOR scanarrayp& = UBOUND(counts) TO LBOUND(counts) STEP -1
' FOR u& = Counts(scanarrayp&) - 1 TO 0 STEP -1
' CGSortLibArray(XInsert) = scanarrayp& + MinArray
' XInsert = XInsert - 1
' NEXT
' '* REDIM _PRESERVE Counts(scanarrayp& TO finish) AS LONG
' NEXT
' END IF
' ERASE Counts
' END IF
' END IF
'END SUB
'SUB CountingSortInteger (CGSortLibArray() AS DOUBLE, start AS LONG, finish AS LONG, order&)
' DIM CSmmrec AS MinMaxRec
' GetMinMaxArray CGSortLibArray(), start, finish, CSmmrec
' DIM XInsert AS LONG: XInsert = 0
' IF CGSortLibArray(CSmmrec.min) <> CGSortLibArray(CSmmrec.max) THEN
' REDIM Counts(CGSortLibArray(CSmmrec.min) TO CGSortLibArray(CSmmrec.max)) AS LONG
' FOR scanarrayp& = start TO finish
' Counts(CLNG(CGSortLibArray(scanarrayp&))) = Counts(CLNG(CGSortLibArray(scanarrayp&))) + 1
' NEXT
' IF order& = 1 THEN
' XInsert = start
' FOR scanarrayp& = LBOUND(counts) TO UBOUND(counts)
' FOR u& = 0 TO Counts(scanarrayp&) - 1
' CGSortLibArray(XInsert) = scanarrayp&
' XInsert = XInsert + 1
' NEXT
' NEXT
' ELSE
' XInsert = start
' FOR scanarrayp& = UBOUND(counts) TO LBOUND(counts) STEP -1
' FOR u& = 0 TO Counts(scanarrayp&) - 1
' CGSortLibArray(XInsert) = scanarrayp&
' XInsert = XInsert + 1
' NEXT
' NEXT
' END IF
' '* clear the Counts() array
' ERASE Counts
' END IF
'END SUB
ArrayIsInteger CGSortLibArray(), start, finish, FirstNonIntegerElement&, errcon&
CountingSortNonInteger CGSortLibArray(), start, finish, order&
CSmmrec.min = start
CSmmrec.max = finish
FOR scanarrayp&
= start
TO finish
IF CGSortLibArray
(scanarrayp&
) < CGSortLibArray
(CSmmrec.min
) THEN CSmmrec.min
= scanarrayp&
IF CGSortLibArray
(scanarrayp&
) > CGSortLibArray
(CSmmrec.max
) THEN CSmmrec.max
= scanarrayp&
IF CGSortLibArray
(CSmmrec.min
) <> CGSortLibArray
(CSmmrec.max
) THEN '* PRINT CGSortLibArray(CSmmrec.min); CGSortLibArray(CSmmrec.max)
'* no scaling needed
DIM cgslam
AS DOUBLE: cgslam
= CGSortLibArray
(CSmmrec.min
) REDIM Counts
(0 TO CGSortLibArray
(CSmmrec.max
) - CGSortLibArray
(CSmmrec.min
)) AS LONG FOR scanarrayp&
= start
TO finish
Counts(CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min)) = Counts(CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min)) + 1
XInsert = start
FOR u&
= 0 TO Counts
(scanarrayp&
) - 1 CGSortLibArray(XInsert) = scanarrayp& + cgslam
XInsert = XInsert + 1
XInsert = start
FOR u&
= 0 TO Counts
(scanarrayp&
) - 1 CGSortLibArray(XInsert) = scanarrayp& + cgslam
XInsert = XInsert + 1
'* clear the Counts() array
'************************************
'* CountingSort() extended to non-integer
'* complexity class: O(N) -- Typical throughput: 600,000 double-precision/GHzS
'************************************
GetMinMaxArray CGSortLibArray(), start, finish, CSmmrec
IF CGSortLibArray
(CSmmrec.min
) <> CGSortLibArray
(CSmmrec.max
) THEN FindNonZeroElement CGSortLibArray(), start, finish, ascale#
IF ascale#
* (CGSortLibArray
(CSmmrec.max
) - CGSortLibArray
(CSmmrec.min
)) > (2 ^ 32) / (LEN(CGSortLibArray
(start
))) THEN MergeSortEmerge CGSortLibArray(), start, finish, order&
DIM cgslam
AS DOUBLE: cgslam
= CGSortLibArray
(CSmmrec.min
) cgslam = CGSortLibArray(CSmmrec.min)
REDIM Counts
(0 TO ascale#
* (CGSortLibArray
(CSmmrec.max
) - CGSortLibArray
(CSmmrec.min
))) AS LONG FOR scanarrayp&
= start
TO finish
Counts(ascale# * (CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min))) = Counts(ascale# * (CGSortLibArray(scanarrayp&) - CGSortLibArray(CSmmrec.min))) + 1
XInsert = start
FOR u&
= 0 TO Counts
(scanarrayp&
) - 1 CGSortLibArray(XInsert) = scanarrayp& + cgslam
XInsert = XInsert + 1
XInsert = start
FOR u&
= 0 TO Counts
(scanarrayp&
) - 1 CGSortLibArray(XInsert) = scanarrayp& + cgslam
XInsert = XInsert + 1
'* clear the Counts() array
'***********************************
'* finds the lowest power of 2 when multiplied by each array element yields an integer result
'***********************************
FindNZOScale = 1
DIM LowestNonZeroElement
AS LONG: LowestNonZeroElement
= start
- 1 DIM highestNonZeroElement
AS LONG: highestNonZeroElement
= start
- 1 FOR find_nzo
= start
TO finish
IF LowestNonZeroElement
> start
- 1 THEN IF Cg
(find_nzo
) < Cg
(LowestNonZeroElement
) THEN LowestNonZeroElement = find_nzo
IF Cg
(find_nzo
) > Cg
(LowestNonZeroElement
) THEN highestNonZeroElement = find_nzo
LowestNonZeroElement = find_nzo
highestNonZeroElement = find_nzo
curhighp = 1
DO UNTIL curhighp
* Cg
(find_nzo
) = INT(curhighp
* Cg
(find_nzo
)) curhighp = curhighp * 2
IF curhighp
> FindNZOScale
THEN FindNZOScale = curhighp
'* from this:
'#define BEAD(i, j) beads[i * max + j]
'// function to perform the above algorithm
'void beadSort(int *a, int len)
'{
' // Find the maximum element
' int max = a[start];
' for (int i = 1; i < len; i++)
' if (a[i] > max)
' max = a[i];
' // allocating memory
' unsigned char beads[max*len];
' memset(beads, 0, sizeof(beads));
' // mark the beads
' for (int i = 0; i < len; i++)
' for (int j = 0; j < a[i]; j++)
' BEAD(i, j) = 1;
' for (int j = 0; j < max; j++)
' {
' // count how many beads are on each post
' int sum = 0;
' for (int i=0; i < len; i++)
' {
' sum += BEAD(i, j);
' BEAD(i, j) = 0;
' }
' // Move beads down
' for (int i = len - sum; i < len; i++)
' BEAD(i, j) = 1;
' }
' // Put sorted values in array using beads
' for (int i = 0; i < len; i++)
' {
' int j;
' for (j = 0; j < max && BEAD(i, j); j++);
' a[i] = j;
' }
'}
'* to this:
'***************************************************
'* BeadSortInteger() is VERY fast. Typical performance is O(N), meaning only a constant extra
'* time per additional element. There was no QB64 code for this sort, so I whipped one up from
'* a c++ example. Translated, tested and such 06 Apr 2018. Everyone seems to think arrays always
'* need to be manipulated across their entire length. Sometimes a partial is all that's really
'* necessary. BeadSort performs in O(NlogN) (roughly same as quicksort -- WORST case. Usually O(n).
'* As key values (array values and ranges) go up, performance remains steady and predictable although
'* at larger bit ranges, it slows appreciably but still performs categorically O(NLogN), with a higher
'* constant. excellent for all integer array numerical distributions provided there is enough memory.
'* Integer/positive only at this point. Throughput is roughly 1000k+/GHzS for double-precision. This
'* is Related to CountingSort(). So far only useful for integers but I'm working on a modification
'* like I did to CountingSort() so it can be used with non-integer arrays as well.
'***************************************************
DIM BeadSort_MAX
AS DOUBLE: BeadSort_MAX
= CGSortLibArray
(start
)
FOR BeadSort_I
= start
+ 1 TO (finish
- start
) IF (CGSortLibArray
(BeadSort_I
) > BeadSort_MAX
) THEN BeadSort_MAX
= CGSortLibArray
(BeadSort_I
)
FOR BeadSort_I
= 0 TO (finish
- start
) - 1 FOR BeadSort_J
= 0 TO CGSortLibArray
(BeadSort_I
) - 1 beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_J
= 0 TO BeadSort_MAX
BeadSort_Sum = 0
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_Sum = BeadSort_Sum + beads(BeadSort_I, BeadSort_J)
beads(BeadSort_I, BeadSort_J) = 0
FOR BeadSort_I
= (finish
- start
) - BeadSort_Sum
TO (finish
- start
) beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_J = 0
WHILE BeadSort_J
< BeadSort_MAX
AND beads
(BeadSort_I
, BeadSort_J
) BeadSort_J = BeadSort_J + 1
CGSortLibArray(BeadSort_I) = BeadSort_J
BeadSort_Sum = 0
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_Sum = BeadSort_Sum + beads(BeadSort_I, BeadSort_J)
beads(BeadSort_I, BeadSort_J) = 0
FOR BeadSort_I
= (finish
- start
) TO (finish
- start
) - BeadSort_Sum
STEP -1 beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_J = 0
WHILE BeadSort_J
< max
AND beads
(BeadSort_I
, BeadSort_J
) BeadSort_J = BeadSort_J + 1
CGSortLibArray(finish - BeadSort_I) = BeadSort_J
'***************************************************
'* BeadSortInteger() is VERY fast. Typical performance is O(N), meaning only a constant extra
'* time per additional element. There was no QB64 code for this sort, so I whipped one up from
'* a c++ example. Translated, tested and such 06 Apr 2018. Everyone seems to think arrays always
'* need to be manipulated across their entire length. Sometimes a partial is all that's really
'* necessary. BeadSort performs in O(NlogN) (roughly same as quicksort -- WORST case. Usually O(n).
'* As key values (array values and ranges) go up, performance remains steady and predictable although
'* at larger bit ranges, it slows appreciably but still performs categorically O(NLogN), with a higher
'* constant. excellent for all integer array numerical distributions provided there is enough memory.
'* Integer/positive only at this point. Throughput is roughly 1000k+/GHzS for double-precision. This
'* is Related to CountingSort(). So far only useful for integers but I'm working on a modification
'* like I did to CountingSort() so it can be used with non-integer arrays as well.
'***************************************************
mmrec.min = start
mmrec.max = start
IF CGSortLibArray
(u&
) < CGSortLibArray
(mmrec.min
) THEN mmrec.min
= u&
IF CGSortLibArray
(u&
) > CGSortLibArray
(mmrec.max
) THEN mmrec.max
= u&
DIM BeadSort_MAX
AS DOUBLE: BeadSort_MAX
= CGSortLibArray
(mmrec.max
) BSNI_dmin = CGSortLibArray(mmrec.min)
FindNonZeroElement CGSortLibArray(), start, finish, BSNIScale
CGSortLibArray(u&) = (CGSortLibArray(u&) - BSNI_dmin) * BSNIScale
FOR BeadSort_I
= 0 TO (finish
- start
) - 1 FOR BeadSort_J
= 0 TO CGSortLibArray
(BeadSort_I
) - 1 beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_J
= 0 TO BeadSort_MAX
BeadSort_Sum = 0
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_Sum = BeadSort_Sum + beads(BeadSort_I, BeadSort_J)
beads(BeadSort_I, BeadSort_J) = 0
FOR BeadSort_I
= (finish
- start
) - BeadSort_Sum
TO (finish
- start
) beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_J = 0
WHILE BeadSort_J
< BeadSort_MAX
AND beads
(BeadSort_I
, BeadSort_J
) BeadSort_J = BeadSort_J + 1
CGSortLibArray(BeadSort_I) = BeadSort_J
BeadSort_Sum = 0
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_Sum = BeadSort_Sum + beads(BeadSort_I, BeadSort_J)
beads(BeadSort_I, BeadSort_J) = 0
FOR BeadSort_I
= (finish
- start
) TO (finish
- start
) - BeadSort_Sum
STEP -1 beads(BeadSort_I, BeadSort_J) = 1
FOR BeadSort_I
= 0 TO (finish
- start
) BeadSort_J = 0
WHILE BeadSort_J
< max
AND beads
(BeadSort_I
, BeadSort_J
) BeadSort_J = BeadSort_J + 1
CGSortLibArray(finish - BeadSort_I) = BeadSort_J
butter& = finish
whippedcream& = start
GetMinMaxArray strawberries(), whippedcream&, butter&, syrup
IF strawberries
(syrup.max
) > strawberries
(butter&
) THEN StableInvert strawberries(), syrup.max, butter&, 1
IF strawberries
(syrup.min
) < strawberries
(whippedcream&
) THEN StableInvert strawberries(), whippedcream&, syrup.min, 1
whippedcream& = whippedcream& + 1
butter& = butter& - 1
StableInvert strawberries(), statrt, finish, 1
h& = start
Inverted(Invertcount&) = CG(q&)
Invertcount& = Invertcount& + 1
InOrder(inordercount&) = CG(q&)
inordercount& = inordercount& + 1
h& = q&
SUB OneZeroSort
(cg
() AS DOUBLE, start
, finish
, order&
) left = left + 1
right = right - 1
left = left + 1
right = right - 1
left = left + 1
right = right - 1
left = left + 1
right = right - 1
'***************************
'* Another specialized numeric sort: It is asymmetric, meaning sortation from reverse-ordered
'* datasets takes roughly twice as long. Even in this case, it is faster than FlashSort. This
'* sort method is EXTREMELY fast when used within design constraints: namely, integer and
'* consecutive sequential. UniqueIntegerSort is between 3 and 4 times
'* as fast as FlashSort, the fastest general-purpose number-specific sort in this library.
'* works only under specific circumstances and not easily adaptable to nonnumeric string
'* complexity class: O(n).
'***************************
DO UNTIL cgSortLibArr
(c&
) <= c&
'* can be just = too. SWAP cgSortLibArr
(c&
), cgSortLibArr
(cgSortLibArr
(c&
)) '* this step corrects asymmetric performance
'* since these are unique integers in a range,
'* restabilization is unnecessary.
StableInvert cgSortLibArr(), start, finish, 0
'IF order& = 1 THEN
' FOR c& = start TO finish
' DO UNTIL a(c&) = c&
' SWAP a(c&), a(a(c&))
' LOOP
' NEXT
'ELSE
' FOR c& = start TO finish
' k& = finish - c&
' DO UNTIL a(c&) = k&
' SWAP a(c&), a(finish - a(c&))
' LOOP
' NEXT
'END IF
'* do you need to know where an array of values balances? Good for balancing and constraint problems
'* such as maximum loading capacity.
lsum = 0
rsum = 0
MergeSortEmerge cg(), start, finish, order&
rsum = rsum + cg(rindex&)
rindex& = rindex& - 1
lsum = lsum + cg(lindex&)
lindex& = lindex& + 1
lsum = lsum + cg(rindex&)
lindex& = lindex& + 1
rsum = rsum + cg(rindex&)
rindex& = rindex& - 1
PartitionIndex& = lindex&
'* Only works for integer nonnegative arrays
Average# = 0
StatN& = finish - start + 1
FOR i&
= start&
TO finish&
xn = xn + ch(i&) / StatN&
xn = xn + 1
yn = yn - StatN& - cg(i&)
xn = xn - cg(i&)
xP = xP + cg(i&) / StatN&
xP = xP + 1
YP = YP - N + B
YP = YP + B
Average# = xP + YP / StatN&
DIM CGModeNext
AS LONG: CGModeNext
= start
+ 1 DIM CModeCountCurrent
AS LONG: CModeCountCurrent
= 0 CModeCountCurrent = 0
IF CGSortLibArr
(CGModeNext
) = CGSortLibArr
(CGModePrev
) THEN CGModeNext = CGModeNext + 1
CModeCountCurrent = CModeCountCurrent + 1
IF CModeCountCurrent
> CGModeCountMaximum
THEN CGModeCountMaximumIndex = CGModePrev
CGModeCountMaximum = CModeCountCurrent
CGModePrev = CGModeNext
CGModeNext = CGModePrev + 1
'************************ 8156035173
DIM UNSMMrec
AS MinMaxRec
GetMinMaxArray cgSortLibArr(), start, finish, UNSMMrec
UNSRange = cgSortLibArr(UNSMMrec.max) - cgSortLibArr(UNSMMrec.min)
SWAP cgSortLibArr
(start
), cgSortLibArr
(UNSMMrec.min
) SWAP cgSortLibArr
(finish
), cgSortLibArr
(UNSMMrec.max
) RangeDeltaPerOne# = UNSRange / (finish - start + 1)
ISum# = cgSortLibArr(UNSMMrec.min)
FOR c&
= start
+ 1 TO finish
- 1 DO UNTIL cgSortLibArr
(c&
) <= ISum#
'* can be just = too. SWAP cgSortLibArr
(c&
), cgSortLibArr
(cgSortLibArr
(c&
)) ISum# = ISum# + RangeDeltaPerOne#
'* this step corrects asymmetric performance
'* since these are unique integers in a range,
'* restabilization is unnecessary.
StableInvert cgSortLibArr(), start, finish, 0
InsertionSort cgSortLibArr(), start, finish, order&
'**********************************************
'* the even FASTER version of FlashSort using the fastest vector min-max search I know.
'* short of using c++ STL, I don't believe there to be any faster method, even STL itself.
'*********************************************
'* GetMinMaxArrayIndexes CGSortLibArr(), start, finish, FlashMM.min, FlashMM.max
GetMinMaxArray CGSortLibArr(), start, finish, FlashMM
'* change these:
'* to the same type as the array being sorted
'* change these:
'* to long for qbxx as qbxx has no _unsigned types
'* the original ratio was .125 but i kept getting array bounds errors
MIndex
= (INT(.128 * (finish
- start
+ 1)) + 1) OR 2
'* change these:
'* to the appropriate type for the range being sorted (must match start, finish variables)
'* don't mess:
DIM FlashC1
AS DOUBLE '* for some reason does not work with _float '* with this. it needs to be a double at the very least but float gives this a far greater range
'* more than likely more range than is practical. but ya never know (change this to double for qbxx)
' sorts array A with finish elements by use of
' index vector L with M elements, with M ca. 0.128(finish-start).
' Translation of Karl-Dietrich Neubert's FlashSort
' algorithm into BASIC by Erdmann Hess.
' Generalized Numeric Version -- recoded by codeguy
'* This is the absolute quickest sorting algorithm I can find for numeric arrays. Unfortunately, generalizing this for
'* strings may require some work. sounds like a project to me. I have changed a couple things from the original,
'* namely that .125 has been changed to .128. It seems that after a few runs on randomized data, a subscript error
'* kept popping up. Traced it to FlashTrackL() and added a minor (about 2.4&) increase in the upper bound of FlashTrackL().
'* I suppose this could also be used for non-integer and non-string types as well. Note: For very large N, HashListSort()
'* works even faster and has a similar memory footprint. But yes, this is still faster than QuickSort for N>10000 and like
'* HashListSort, operates in asymptotically close to O(N) time.
REM =============== CLASS FORMATION
=================
';* ANMiN = CGSortLibArr(start)
SWAP CGSortLibArr
(FlashMM.min
), CGSortLibArr
(start
): FlashMM.min
= start: ANMiN
= CGSortLibArr
(FlashMM.min
) SWAP CGSortLibArr
(FlashMM.max
), CGSortLibArr
(finish
): FlashMM.max
= finish
IF ANMiN
= CGSortLibArr
(FlashMM.max
) THEN '* this is a monotonic sequence array and by definition is already sorted
FlashC1 = (MIndex - 1) / (CGSortLibArr(FlashMM.max) - ANMiN)
FOR FlashI
= start
+ 1 TO finish
- 1 KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashI
) - ANMiN
)) + 1 FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1
FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)
REM ==================== PERMUTATION
================ FlashNMove = 0
FlashJ = start + 1
KIndex = MIndex
FinishMinusOne = finish - 1
WHILE (FlashNMove
< FinishMinusOne
) WHILE (FlashJ
> FlashTrackL
(KIndex
)) FlashJ = FlashJ + 1
KIndex
= INT(FlashC1
* (CGSortLibArr
(FlashJ
) - ANMiN
)) + 1 flash = CGSortLibArr(FlashJ)
IF (FlashJ
= (FlashTrackL
(KIndex
) + 1)) THEN IF FlashNMove
< (FinishMinusOne
) THEN KIndex
= INT(FlashC1
* (flash
- ANMiN
)) + 1 hold = CGSortLibArr(FlashTrackL(KIndex))
CGSortLibArr(FlashTrackL(KIndex)) = flash
flash = hold
FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1
FlashNMove = FlashNMove + 1
'================= Insertion Sort============
'* sort subranges
'********************* insertionsortz CGSortLibArr(), FlashTrackL(SIndex - 1), FlashTrackL(SIndex) - 1, order&
FOR FlashI
= FlashTrackL
(SIndex
) - 1 TO FlashTrackL
(SIndex
- 1) STEP -1 IF (CGSortLibArr
(FlashI
+ 1) < CGSortLibArr
(FlashI
)) THEN hold = CGSortLibArr(FlashI)
NextFlashJ = FlashI
FlashJ = NextFlashJ
IF FlashJ
< FlashTrackL
(SIndex
) THEN NextFlashJ = FlashJ + 1
IF (CGSortLibArr
(NextFlashJ
) < hold
) THEN SWAP CGSortLibArr
(FlashJ
), CGSortLibArr
(NextFlashJ
) CGSortLibArr(FlashJ) = hold
'* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.
FlashI = start
FlashJ = finish
SWAP CGSortLibArr
(FlashI
), CGSortLibArr
(FlashJ
) FlashI = FlashI + 1
FlashJ = FlashJ - 1
'DIM GetMinMaxArray_i AS LONG
'* this is a workaround for the irritating malfunction
'* of MOD using larger numbers and small divisors
GetMinMaxArray_n = finish& - start&
int10000& = (finish& - start&) \ 10000
GetMinMaxArray_NMod2 = (finish& - start&) - 10000 * int10000&
'* GetMinMaxArray_NMod2 = GetMinMaxArray_n - 10000 * ((GetMinMaxArray_n - GetMinMaxArray_TT) / 10000)
MinMaxArrayMin = start&
MinMaxArrayMax = start&
GetMinMaxArray_i = start& + 1
IF cg
(start&
) > cg
(finish&
) THEN MinMaxArrayMax = start&
MinMaxArrayMin = finish&
MinMaxArrayMin = finish&
MinMaxArrayMax = start&
GetMinMaxArray_i = start& + 2
WHILE GetMinMaxArray_i
< finish&
IF cg
(GetMinMaxArray_i
) > cg
(GetMinMaxArray_i
+ 1) THEN IF cg
(GetMinMaxArray_i
) > cg
(MinMaxArrayMax
) THEN MinMaxArrayMax = GetMinMaxArray_i
IF cg
(GetMinMaxArray_i
+ 1) < cg
(MinMaxArrayMin
) THEN MinMaxArrayMin = GetMinMaxArray_i + 1
IF cg
(GetMinMaxArray_i
+ 1) > cg
(MinMaxArrayMax
) THEN MinMaxArrayMax = GetMinMaxArray_i + 1
IF cg
(GetMinMaxArray_i
) < cg
(MinMaxArrayMin
) THEN MinMaxArrayMin = GetMinMaxArray_i
GetMinMaxArray_i = GetMinMaxArray_i + 2
'***********************************
'* compares 2 arrays for similarity (equality or inequality).
'* equality will ONLY be satisfied if the range is the same AND all elements of subarrays are equal.
'***********************************
VectorCompA& = astart
VectorCompB& = bstart
IF VectorCompA&
> afinish
THEN IF VectorCompB&
> bfinish
THEN VectorComp% = 0
VectorComp% = -1
IF VectorCompB&
> bfinish
THEN VectorComp% = 1
IF CgSortArrayA
(VectorCompA&
) = CgSortArrayB
(VectorCompB&
) THEN VectorCompA& = VectorCompA& + 1
VectorCompB& = VectorCompB& + 1
ELSEIF CgSortArrayA
(VectorCompA&
) < CgSortArrayB
(VectorCompB&
) THEN VectorComp% = -1
VectorComp% = 1
'****************************
'* THE fastest stable sort I Invented. Just how fast? Compared to standard MergeSort,
'* MergeInsert is 25 percent faster and uses only half the memory. My other method may
'* be stable but it is not guaranteed.
'***************************
m& = start + (finish - start) / 4.390647888183594
MergeInsert CGSortArray(), start, m&, order&
MergeInsert CGSortArray(), m& + 1, finish, order&
Tim_merge CGSortArray(), start, m&, finish, order&
m& = start + (finish - start) / 2
MergeInsert CGSortArray(), start, m&, order&
MergeInsert CGSortArray(), m& + 1, finish, order&
EfficientMerge CGSortArray(), start, finish, order&
'ELSE
' InsertionSort CGSortArray(), start, finish, order&
FOR ExchangeSort_i
= start
TO finish
- 1 FOR ExchangeSort_j
= ExchangeSort_i
+ 1 TO finish
IF (CgSortArray
(ExchangeSort_i
) > CgSortArray
(ExchangeSort_j
)) THEN SWAP CgSortArray
(ExchangeSort_i
), CgSortArray
(ExchangeSort_j
) FOR ExchangeSort_i
= start
TO finish
- 1 FOR ExchangeSort_j
= ExchangeSort_i
+ 1 TO finish
IF (CgSortArray
(ExchangeSort_i
) < CgSortArray
(ExchangeSort_j
)) THEN SWAP CgSortArray
(ExchangeSort_i
), CgSortArray
(ExchangeSort_j
)
