### Author Topic: Sorting Methods. The Best and not necessarily fastest algorithms.  (Read 1015 times)

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Sorting Methods. The Best and not necessarily fastest algorithms.
« on: August 02, 2017, 06:30:57 am »
Sorting is one of the MOST commonly used procedures in data processing. It is also one of the MOST possibly confusing. Picking the correct weapon to use against the enemy (unsorted data) can mean the difference between a program's success or failure. I will present some of my favorites and those regularly shown in programming books and websites, However, my aim is to provide a comprehensive and tested code repository of library-quality code you can use in any program that requires sorting pf any kind and range to be performed flawlessly. I will add sequence verification and data integrity procedures later. Now feauring the latest and greatest: EVEN FASTER THAN FLASHSORT, 25% faster than ALL versions of QuickSort at 16777216 elements. I have also included Order Statistic and basic statistical functions. in the newest iteration. Modified 2018-Feb-09 to include corrections and standardize array types when necessary. Most have been converted to use DOUBLE, except string variants. Also better explanations of the complexity and use cases of these algorithms, several of which have been included as part of Polyphase Merge on TJP: http://qb64.thejoyfulprogrammer.com/showthread.php?tid=121&rndtime=15182198431867255789 as well as here.
Added In-place MergeSort 14 Feb 2018

Code: [Select]
`WIDTH 80, 40REDIM array(0 TO 16777215) AS DOUBLEREDIM b(0 TO UBOUND(array)) AS DOUBLEFOR s& = LBOUND(array) TO UBOUND(array)    array(s&) = (RND * (UBOUND(array) - LBOUND(array) + 1))    b(s&) = array(s&)NEXT'* a simple test of EfficientMergeREDIM a(0 TO 99) AS DOUBLEa& = LBOUND(a)b& = UBOUND(a)c& = (b& - a&) \ 2PRINT c&FOR s& = a& TO c&    a(s&) = s&    PRINT a(s&);NEXTPRINTFOR s& = c& + 1 TO b&    a(s&) = s& - (c& + 1)    PRINT a(s&);NEXTPRINTEfficientMerge a(), a&, b&, 1FOR s& = LBOUND(a) TO UBOUND(a)    PRINT a(s&);NEXTERASE aPRINT'DO'    x\$ = INKEY\$'LOOP UNTIL x\$ > ""'**************** THE END ************`
'*****************************
Code: [Select]
`'**********************'* does what it says'**********************SUB CountSortedReps (Array() AS DOUBLE, start&, finish&)REDIM ElementCounts(0 TO 0) AS LONGREDIM ElementPointers(0 TO 0) AS LONGProbeCount& = LBOUND(array)ElementCountIndex& = LBOUND(ElementCounts)s& = start&DO    IF s& > finish& THEN        EXIT DO    ELSE        ElementPointers(ElementCountIndex&) = s&        r& = s&        DO            IF r& > finish& THEN                EXIT DO            ELSE                IF Array(r&) = Array(s&) THEN                    ElementCounts(ElementCountIndex&) = ElementCounts(ElementCountIndex&) + 1                    r& = r& + 1                ELSE                    EXIT DO                END IF            END IF        LOOP        s& = r&        ElementCountIndex& = ElementCountIndex& + 1        IF ElementCountIndex& > UBOUND(ElementCounts) THEN            REDIM _PRESERVE ElementCounts(LBOUND(elementcounts) TO ElementCountIndex&)            REDIM _PRESERVE ElementPointers(LBOUND(ElementPointers) TO ElementCountIndex&)        END IF    END IFLOOPFOR s& = LBOUND(elementcounts) TO UBOUND(elementcounts)    PRINT "("; Array(ElementPointers(s&)); ElementCounts(s&); ")";NEXTEND SUB'***************'* Kth smallest element in array(). Sort of like QuickSort'* the Kth smallest element in array() will be at index K&'***************SUB OrderStatisticK (array() AS LONG, start&, finish&, k&)DIM PivotX AS LONGlower& = start&upper& = finish& - 1WHILE lower& < upper&    i& = lower&    j& = upper&    PivotX = array(k&)    WHILE i& <= k& AND j& >= k&        WHILE array(i&) < PivotX            i& = i& + 1        WEND        WHILE array(j&) > PivotX            j& = j& - 1        WEND        SWAP array(i&), array(j&)        i& = i& + 1        j& = j& - 1    WEND    IF j& < k& THEN        lower& = i&    END IF    IF i& > k& THEN        upper& = j&    END IFWENDEND SUB'******************************************' sorts array() 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 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 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.'*********************************************SUB FlashSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&)'* change these:REDIM p(0 TO 2) AS LONGDIM hold AS DOUBLEDIM flash AS DOUBLEDIM ANMiN AS DOUBLE'* to the same type as the array being sorted'* change these:DIM KIndex AS LONGDIM MIndex AS LONGDIM SIndex AS LONG'* to long for qbxx as qbxx has no _unsigned types'* the original ratio was .125 but i kept getting array bounds errorsMIndex = (INT(.128 * (finish - start + 1)) + 1) OR 2'* change these:DIM FlashTrackL(0 TO MIndex) AS LONGDIM FlashI AS LONGDIM FlashJ AS LONGDIM NextFlashJ AS LONGDIM FlashNMove AS LONGDIM MaxValueIndex AS LONGDIM MinValueIndex AS LONGDIM FinishMinusOne AS LONG'* 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 = Array(start&)MaxValueIndex = finish&MinValueIndex = start&FOR FlashI = start& TO finish&    IF (Array(FlashI) > Array(MaxValueIndex)) THEN MaxValueIndex = FlashI    IF (Array(FlashI) < Array(MinValueIndex)) THEN MinValueIndex = FlashINEXT FlashISWAP Array(MinValueIndex), Array(start&): MinValueIndex = start&: ANMiN = Array(MinValueIndex)SWAP Array(MaxValueIndex), Array(finish&): MaxValueIndex = finish&IF ANMiN = Array(MaxValueIndex) THEN    '* this is a monotonic sequence array and by definition is already sorted    EXIT SUBEND IFDIM FlashTrackL(MIndex)FlashC1 = (MIndex - 1) / (Array(MaxValueIndex) - ANMiN)FOR FlashI = start + 1 TO finish - 1    KIndex = INT(FlashC1 * (Array(FlashI) - ANMiN)) + 1    FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1NEXTFOR KIndex = LBOUND(FlashTrackL) + 1 TO MIndex    FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)NEXT KIndexREM ==================== PERMUTATION ================FlashNMove = 0FlashJ = start + 1KIndex = MIndexFinishMinusOne = finish - 1WHILE (FlashNMove < FinishMinusOne)    WHILE (FlashJ > FlashTrackL(KIndex))        FlashJ = FlashJ + 1        KIndex = INT(FlashC1 * (Array(FlashJ) - ANMiN)) + 1    WEND    flash = Array(FlashJ)    DO        IF (FlashJ = (FlashTrackL(KIndex) + 1)) THEN            EXIT DO        ELSE            IF FlashNMove < (FinishMinusOne) THEN                KIndex = INT(FlashC1 * (flash - ANMiN)) + 1                hold = Array(FlashTrackL(KIndex))                Array(FlashTrackL(KIndex)) = flash                flash = hold                FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1                FlashNMove = FlashNMove + 1            ELSE                EXIT DO            END IF        END IF    LOOPWEND'================= Insertion Sort============FOR SIndex = LBOUND(FlashtrackL) + 1 TO MIndex    '* sort subranges    FOR FlashI = FlashTrackL(SIndex) - 1 TO FlashTrackL(SIndex - 1) STEP -1        IF (Array(FlashI + 1) < Array(FlashI)) THEN            hold = Array(FlashI)            NextFlashJ = FlashI            DO                FlashJ = NextFlashJ                IF FlashJ < FlashTrackL(SIndex) THEN                    NextFlashJ = FlashJ + 1                    IF (Array(NextFlashJ) < hold) THEN                        SWAP Array(FlashJ), Array(NextFlashJ)                    ELSE                        EXIT DO                    END IF                ELSE                    EXIT DO                END IF            LOOP            Array(FlashJ) = hold        END IF    NEXT    '* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.NEXTIF order& = 1 THEN EXIT SUBFlashI = startFlashJ = finishWHILE FlashJ > FlashI    SWAP Array(FlashI), Array(FlashJ)    FlashI = FlashI + 1    FlashJ = FlashJ - 1WENDEND SUB'********************'* 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.'********************SUB InsertionSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        FOR i& = start& + 1 TO finish&            FOR j& = i& TO start& + 1 STEP -1                IF Array(j& - 1) > Array(j&) THEN                    SWAP Array(j&), Array(j& - 1)                ELSE                    EXIT FOR                END IF            NEXT        NEXT    CASE ELSE        FOR i& = start& + 1 TO finish&            FOR j& = i& TO start& + 1 STEP -1                IF Array(j& - 1) < Array(j&) THEN                    SWAP Array(j&), Array(j& - 1)                ELSE                    EXIT FOR                END IF            NEXT        NEXTEND SELECTEND SUB'******************************'* 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 (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE finish& - start&    CASE 1        IF Array(start&) > Array(finish&) THEN            IF order& = 1 THEN                SWAP Array(start&), Array(finish&)            END IF        END IF    CASE IS > 1        IF order& = 1 THEN            ShellSortGap& = (finish& - start&) \ 2            DO                IF ShellSortGap& > 1 THEN                    LoopCount& = 0                    xstart& = start&                    xfinish& = finish& - ShellSortGap&                    MaxPasses& = (finish& - start&) \ ShellSortGap&                    DO                        xfirst& = xfinish&                        FOR ShellSortS& = xstart& TO xfinish&                            IF Array(ShellSortS&) > Array(ShellSortS& + ShellSortGap&) THEN                                SWAP Array(ShellSortS&), Array(ShellSortS& + ShellSortGap&)                                Last& = ShellSortS&                                IF ShellSortS& < xfirst& THEN                                    xfirst& = ShellSortS&                                END IF                            END IF                        NEXT                        xfinish& = Last&                        xstart& = xfirst&                        LoopCount& = LoopCount& + 1                    LOOP WHILE LoopCount& < MaxPasses& AND (xfinish& - xstart&) >= ShellSortGap&                    ShellSortGap& = ShellSortGap& \ 2                ELSE                    InsertionSort Array(), start&, finish&, order&                    EXIT DO                END IF            LOOP        ELSE            ShellSortGap& = (finish& - start&) \ 2            DO                IF ShellSortGap& > 1 THEN                    LoopCount& = 0                    xstart& = start&                    xfinish& = finish& - ShellSortGap&                    MaxPasses& = (finish& - start&) \ ShellSortGap&                    DO                        xfirst& = xfinish&                        FOR ShellSortS& = xstart& TO xfinish&                            IF Array(ShellSortS&) < Array(ShellSortS& + ShellSortGap&) THEN                                SWAP Array(ShellSortS&), Array(ShellSortS& + ShellSortGap&)                                Last& = ShellSortS&                                IF ShellSortS& < xfirst& THEN                                    xfirst& = ShellSortS&                                END IF                            END IF                        NEXT                        xfinish& = Last&                        xstart& = xfirst&                        LoopCount& = LoopCount& + 1                    LOOP WHILE LoopCount& < MaxPasses& AND (xfinish& - xstart&) >= ShellSortGap&                    ShellSortGap& = ShellSortGap& \ 2                ELSE                    InsertionSort Array(), start&, finish&, order&                    EXIT DO                END IF            LOOP        END IFEND SELECTEND SUB'*******************************************'* 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 (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        gap& = (finish& - start& + 1) \ 2        DO            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            DO                IF up% THEN                    up% = 0                    FOR i& = startup& TO endup&                        IF Array(i&) > Array(i& + gap&) THEN                            SWAP Array(i&), Array(i& + gap&)                            IF i& < FirstUp& THEN                                FirstUp& = i&                            END IF                            LastUp& = i&                            up% = -1                        END IF                    NEXT                    startup& = FirstUp&                    endup& = LastUp&                    SWAP FirstUp&, LastUp&                END IF                '*******************************                IF down% THEN                    down% = 0                    FOR i& = startdn& TO enddown& STEP -1                        IF Array(i&) < Array(i& - gap&) THEN                            SWAP Array(i&), Array(i& - gap&)                            IF i& > FirstDown& THEN                                FirstDown& = i&                            END IF                            LastDown& = i&                            down% = -1                        END IF                    NEXT                    startdn& = FirstDown&                    enddown& = LastDown&                    SWAP FirstDown&, LastDown&                END IF                IF passes& < maxpasses& THEN                    IF up% OR down% THEN                        IF passes& < (enddown& - startdown&) \ gap& - 1 OR passes& < (endup& - startup&) \ gap& - 1 THEN                            passes& = passes& + 1                        ELSE                            EXIT DO                        END IF                    ELSE                        EXIT DO                    END IF                ELSE                    EXIT DO                END IF            LOOP            gap& = gap& \ 2        LOOP WHILE gap& > 0    CASE ELSE        gap& = (finish& - start& + 1) \ 2        DO            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&            DO                IF up% THEN                    up% = 0                    FOR i& = startup& TO endup&                        IF Array(i&) < Array(i& + gap&) THEN                            SWAP Array(i&), Array(i& + gap&)                            IF i& < FirstUp& THEN                                FirstUp& = i&                            END IF                            LastUp& = i&                            up% = -1                        END IF                    NEXT                    startup& = FirstUp&                    endup& = LastUp&                    SWAP FirstUp&, LastUp&                END IF                '*******************************                IF down% THEN                    down% = 0                    FOR i& = startdn& TO enddown& STEP -1                        IF Array(i&) > Array(i& - gap&) THEN                            SWAP Array(i&), Array(i& - gap&)                            IF i& > FirstDown& THEN                                FirstDown& = i&                            END IF                            LastDown& = i&                            down% = -1                        END IF                    NEXT                    startdn& = FirstDown&                    enddown& = LastDown&                    SWAP FirstDown&, LastDown&                END IF                IF passes& < maxpasses& THEN                    IF up% OR down% THEN                        IF passes& < (enddown& - startdown&) \ gap& - 1 OR passes& < (endup& - startup&) \ gap& - 1 THEN                            passes& = passes& + 1                        ELSE                            EXIT DO                        END IF                    ELSE                        EXIT DO                    END IF                ELSE                    EXIT DO                END IF            LOOP            gap& = gap& \ 2        LOOP WHILE gap& > 0END SELECTEND SUB'*******************************************'* 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 presemt 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 (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE finish& - start&    CASE 1        '* This is CRITICAL        SELECT CASE order&            CASE 1                IF Array(start&) > Array(finish&) THEN                    SWAP Array(start&), Array(finish&)                END IF            CASE ELSE                IF Array(start&) < Array(finish&) THEN                    SWAP Array(start&), Array(finish&)                END IF        END SELECT    CASE IS > 1        QuickSortIJ Array(), start&, finish&, i&, j&, order&        IF (i& - start&) < (finish& - j&) THEN            QuickSortRecursive Array(), start&, j&, order&            QuickSortRecursive Array(), i&, finish&, order&        ELSE            QuickSortRecursive Array(), i&, finish&, order&            QuickSortRecursive Array(), start&, j&, order&        END IFEND SELECTEND SUB'*********************************'* 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.SUB QuickSortIterative (Array() AS DOUBLE, Start&, Finish&, order&)DIM compare AS DOUBLEMinStack& = LOG(Finish& - Start& + 1) \ LOG(2) + 1DIM LStack&(MinStack&, 1)StackPtr& = 0LStack&(StackPtr&, 0) = Start&LStack&(StackPtr&, 1) = Finish&DO    Low& = LStack&(StackPtr&, 0)    Hi& = LStack&(StackPtr&, 1)    DO        i& = Low&        j& = Hi&        Mid& = Low& + (Hi& - Low& + 1) \ 2        compare = Array(Mid&)        SELECT CASE order&            CASE 1                DO                    DO WHILE Array(i&) < compare                        i& = i& + 1                    LOOP                    DO WHILE Array(j&) > compare                        j& = j& - 1                    LOOP                    IF i& <= j& THEN                        SWAP Array(i&), Array(j&)                        i& = i& + 1                        j& = j& - 1                    END IF                LOOP UNTIL i& > j&            CASE ELSE                DO                    DO WHILE Array(i&) > compare                        i& = i& + 1                    LOOP                    DO WHILE Array(j&) < compare                        j& = j& - 1                    LOOP                    IF i& <= j& THEN                        SWAP Array(i&), Array(j&)                        i& = i& + 1                        j& = j& - 1                    END IF                LOOP UNTIL i& > j&        END SELECT        IF j& - Low& < Hi& - i& THEN            IF i& < Hi& THEN                LStack&(StackPtr&, 0) = i&                LStack&(StackPtr&, 1) = Hi&                StackPtr& = StackPtr& + 1            END IF            Hi& = j&        ELSE            IF Low& < j& THEN                LStack&(StackPtr&, 0) = Low&                LStack&(StackPtr&, 1) = j&                StackPtr& = StackPtr& + 1            END IF            Low& = i&        END IF    LOOP WHILE Low& < Hi&    StackPtr& = StackPtr& - 1LOOP UNTIL StackPtr& < 0END SUB'************************'* 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 (Array() AS DOUBLE, start&, finish&, order&)'* these MUST be the same type as an element of Arrray()DIM CompareP AS DOUBLEDIM CompareQ AS DOUBLE'*********************IF start& < finish& THEN    CompareP = Array(start&)    CompareQ = Array(finish&)    IF order& = 1 THEN        IF CompareP > CompareQ THEN            SWAP Array(start&), Array(finish&)            SWAP CompareP, CompareQ        END IF    ELSE        IF CompareP < CompareQ THEN            SWAP Array(start&), Array(finish&)            SWAP CompareP, CompareQ        END IF    END IF    l& = start& + 1    k& = l&    g& = finish& - 1    SELECT CASE order&        CASE 1            WHILE k& <= g&                IF Array(k&) < CompareP THEN                    SWAP Array(k&), Array(l&)                    l& = l& + 1                ELSE                    IF Array(k&) >= CompareQ THEN                        WHILE Array(g&) >= CompareQ AND k& < g&                            g& = g& - 1                        WEND                        SWAP Array(k&), Array(g&)                        g& = g& - 1                        IF Array(k&) <= CompareP THEN                            SWAP Array(k&), Array(l&)                            l& = l& + 1                        END IF                    END IF                END IF                k& = k& + 1            WEND        CASE ELSE            WHILE k& <= g&                IF Array(k&) > CompareP THEN                    SWAP Array(k&), Array(l&)                    l& = l& + 1                ELSE                    IF Array(k&) <= CompareQ THEN                        WHILE Array(g&) <= CompareQ AND k& < g&                            g& = g& - 1                        WEND                        SWAP Array(k&), Array(g&)                        g& = g& - 1                        IF Array(k&) >= CompareP THEN                            SWAP Array(k&), Array(l&)                            l& = l& + 1                        END IF                    END IF                END IF                k& = k& + 1            WEND    END SELECT    l& = l& - 1    g& = g& + 1    SWAP Array(start&), Array(l&)    SWAP Array(finish&), Array(g&)    QuickSortDualPivot Array(), start&, l& - 1, order&    QuickSortDualPivot Array(), l& + 1, g& - 1, order&    QuickSortDualPivot Array(), g& + 1, finish&, order&END IFEND SUB'***********************'* 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 plus a few variables. With EfficientMerge, memory'* overhead is halved, thus saving costly array copying.'***********************SUB MergeSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE finish& - start&    CASE IS > 31        middle& = start& + (finish& - start&) \ 2        MergeSort Array(), start&, middle&, order&        MergeSort Array(), middle& + 1, finish&, order&        IF order& = 1 THEN            EfficientMerge Array(), start&, finish&, order&        ELSE            MergeRoutine Array(), start&, finish&, order&        END IF    CASE IS > 0        InsertionSort Array(), start&, finish&, order&END SELECTEND SUB'*****************'* Not generally useful, except in cases of very small (finish&-start&), aka N, or as a first taught sorting algorithm.'* the loop invariant is that after completing the inner loop, Array(i&) is always the iTH least or greatest element,'* depending on sort order. There are multiple variations, like Bidirectional, for one. The Complexity is O(n^2), not'* useful for large N, but for small N, this CAN be useful and faster than other sorts, especially if array() is mostly'* ordered. It is a stable sort.'*****************SUB BubbleSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        DO            changed& = 0            FOR I& = start& TO finish& - 1                IF Array(I&) > Array(I& + 1) THEN                    SWAP Array(I&), Array(I& + 1)                    changed& = -1                END IF            NEXT        LOOP WHILE changed&    CASE ELSE        DO            changed& = 0            FOR I& = start& TO finish& - 1                IF Array(I&) < Array(I& + 1) THEN                    SWAP Array(I&), Array(I& + 1)                    changed& = -1                END IF            NEXT        LOOP WHILE changed&END SELECTEND SUB'**************************'* 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 (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        runs& = 0        DO            p& = finish& - runs&            done& = 1 '* assume it's sorted            FOR i& = start& + runs& TO finish& - runs& - 1                IF Array(i&) > Array(i& + 1) THEN                    SWAP Array(i&), Array(i& + 1)                    done& = 0                END IF                IF Array(p&) < Array(p& - 1) THEN                    SWAP Array(p&), Array(p& - 1)                    done& = 0                END IF                p& = p& - 1            NEXT            runs& = runs& + 1        LOOP UNTIL done&    CASE ELSE        runs& = 0        DO            p& = finish& - runs&            done& = 1 '* assume it's sorted            FOR i& = start& + runs& TO finish& - runs& - 1                IF Array(i&) < Array(i& + 1) THEN                    SWAP Array(i&), Array(i& + 1)                    done& = 0                END IF                IF Array(p&) > Array(p& - 1) THEN                    SWAP Array(p&), Array(p& - 1)                    done& = 0                END IF                p& = p& - 1            NEXT            runs& = runs& + 1        LOOP UNTIL done&END SELECTEND SUB'**********************'* helper function for InsertionSortBinary exactly the same as a binary search which runs in O(LogN) time.FUNCTION BinaryB& (Array() AS DOUBLE, start&, Nio&)Bsrcha& = start&BsrchB& = start& + Nio&DO    BsrchC& = Bsrcha& + (BsrchB& - Bsrcha&) \ 2    IF Array(BsrchC&) < Array(Nio&) THEN        Bsrcha& = BsrchC& + 1    ELSE        BsrchB& = BsrchC&    END IFLOOP 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.'* In my expereience, it's approximately 25 percent faster than standard InsertionSort. Because no comparisons are done'* swapping elements down to their final place in the array, this is the only reason it is faster. Still a complexity of'* O(n^2). Stable. A minor modification will allow this to run in O(N) time for already-sorted arrays.'*****************************SUB InsertionSortBinary (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        Nsorted& = 0        Previous& = start&        DO            '* if array(start&+nsorted&) >= array(previos&), it's already in the correct spot            IF Array(start& + Nsorted&) < Array(Previous&) THEN                f& = BinaryB&(Array(), start&, Nsorted&)                p& = start& + Nsorted&                WHILE p& > f&                    x& = p& - 1                    SWAP Array(p&), Array(x&)                    p& = x&                WEND            END IF            Previous& = Nsorted&            Nsorted& = Nsorted& + 1        LOOP UNTIL Nsorted& > finish& - start&    CASE ELSE        Nsorted& = 0        Previous& = start&        DO            '* if array(start&+nsorted&) <= array(previos&), it's already in the correct spot            IF Array(start& + Nsorted&) > Array(Previous&) THEN                f& = BinaryB&(Array(), start&, Nsorted&)                p& = start& + Nsorted&                WHILE p& > f&                    x& = p& - 1                    SWAP Array(p&), Array(x&)                    p& = x&                WEND            END IF            Previous& = Nsorted&            Nsorted& = Nsorted& + 1        LOOP UNTIL Nsorted& > finish& - start&        IF Array(start&) <> Array(finish&) THEN            StableInvert Array(), start&, finish&, 1        END IFEND SELECTEND SUBSUB StableInvert (Array() AS DOUBLE, start&, finish&, dorecurse&)'* first invert then invert the equal elementsa& = start&b& = finish&WHILE a& < b&    SWAP Array(a&), Array(b&)    a& = a& + 1    b& = b& - 1WENDIF dorecurse& THEN    '* then scan the array for runs of equal elements    p& = start&    DO        IF p& < finish& THEN            y& = p& + 1            DO                IF Array(p&) = Array(y&) THEN                    IF y& < finish& THEN                        y& = y& + 1                    ELSE                        StableInvert Array(), p&, y&, 0                        EXIT DO                    END IF                ELSE                    EXIT DO                END IF            LOOP            p& = y&        ELSE            EXIT DO        END IF    LOOPEND IFEND SUB'*****************************************'* BucketSort -- fast but a memory hog (completed). This was an incomplete algorithm in the library. Finished 9 Feb 2018.'* sorts items by "throwing" them in range-determined "buckets" then each bucket is sorted and Array() reconstructed from'* elements of the 2D Bucket() array. Stable as long as a stable algorithm is used on individual buckets. Here, MergeSort()'* is used to maintain stability.'*****************************************SUB BucketSort (Array() AS DOUBLE, start&, finish&, order&)GetMinMaxArray Array(), start&, finish&, a&, b&Range# = Array(b&) - Array(a&)IF Range# > 0 THEN    NBuckets& = 32 '* can be any nonnegative number you like. BUT too many buckets will run you out of memory    N& = (finish& - start&)    r& = N& MOD NBuckets&    REDIM Buckets(NBuckets& - 1, 0 TO (NBuckets& * (1 + (N& - r&) / NBuckets&))) AS DOUBLE '* MUST be same type as Array()    REDIM counts(0 TO NBuckets& - 1) AS LONG '* holds the elements that are in the bucket ranges -- must be same type as array()    BucketSize& = (N& - r&) / NBuckets&    FOR s& = start& TO finish&        Index& = (NBuckets& - 1) * ((Array(s&) - Array(a&)) / ramge#)        Buckets(Index&, counts(Index&)) = Array(s&)        counts(Index&) = counts(Index&) + 1    NEXT    IndexCount& = start&    FOR s& = 0 TO NBuckets& - 1        Last& = IndexCount&        FOR T& = 0 TO counts(Index&) - 1            Array(IndexCount&) = Buckets(s&, T&)            IndexCount& = IndexCount& + 1        NEXT        MergeSort Array(), Last&, IndexCount& - 1, order&    NEXT    ERASE Buckets    ERASE countsEND IFEND SUBSUB InsertionSortx (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        FOR i& = start& + 1 TO finish&            j& = i&            WHILE (j& > start&)                p& = j& - 1                IF Array(p&) > Array(j&) THEN                    SWAP Array(p&), Array(j&)                    j& = p&                ELSE                    EXIT WHILE                END IF            WEND        NEXT    CASE ELSE        FOR i& = start& + 1 TO finish&            j& = i&            WHILE (j& > start&)                p& = j& - 1                IF Array(p&) < Array(j&) THEN                    SWAP Array(p&), Array(j&)                    j& = p&                ELSE                    EXIT WHILE                END IF            WEND        NEXTEND SELECTEND SUB'****************************'* Named for BR Heap. This is also an O(NLogN) algorithm, used as part of IntroSort() and also individually'* The guaranteed upper bound O(NLogN) is useful for sorting all arrays in a determinable time. Bypasses QuickSort()'* pathological behavior on sorted lists in IntroSort().'****************************SUB HeapSort (Array() AS DOUBLE, Start&, Finish&, order&)FOR i& = Start& + 1 TO Finish&    PercolateUp Array(), Start&, i&, order&NEXT i&FOR i& = Finish& TO Start& + 1 STEP -1    SWAP Array(Start&), Array(i&)    PercolateDown Array(), Start&, i& - 1, order&NEXT i&END SUBSUB PercolateDown (Array() 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):DO    Child& = 2 * (i& - Start&) + Start& ' Get the subscript for the Child& node.    ' Reached the bottom of the heap, so exit this procedure:    IF Child& > MaxLevel& THEN EXIT DO    SELECT CASE order&        CASE 1            ' If there are two Child nodes, find out which one is bigger:            ax& = Child& + 1            IF ax& <= MaxLevel& THEN                IF Array(ax&) > Array(Child&) THEN                    Child& = ax&                END IF            END IF            ' Move the value down if it is still not bigger than either one of            ' its Child&ren:            IF Array(i&) < Array(Child&) THEN                SWAP Array(i&), Array(Child&)                i& = Child&                ' Otherwise, array() has been restored to a heap from start& to MaxLevel&,                ' so exit:            ELSE                EXIT DO            END IF        CASE ELSE            ' If there are two Child nodes, find out which one is smaller:            ax& = Child& + 1            IF ax& <= MaxLevel& THEN                IF Array(ax&) < Array(Child&) THEN                    Child& = ax&                END IF            END IF            ' Move the value down if it is still not smaller than either one of            ' its Child&ren:            IF Array(i&) > Array(Child&) THEN                SWAP Array(i&), Array(Child&)                i& = Child&                ' Otherwise, array() has been restored to a heap from start& to MaxLevel&,                ' so exit:            ELSE                EXIT DO            END IF    END SELECTLOOPEND SUBSUB PercolateUp (Array() AS DOUBLE, Start&, MaxLevel&, order&)SELECT CASE order&    CASE 1        i& = MaxLevel&        ' Move the value in array(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):        DO UNTIL i& = Start&            Parent& = Start& + (i& - Start&) \ 2 ' Get the subscript for the parent node.            ' The value at the current node is still bigger than the value at            ' its parent node, so swap these two array elements:            IF Array(i&) > Array(Parent&) THEN                SWAP Array(Parent&), Array(i&)                i& = Parent&                ' Otherwise, the element has reached its proper place in the heap,                ' so exit this procedure:            ELSE                EXIT DO            END IF        LOOP    CASE ELSE        i& = MaxLevel&        ' Move the value in array(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):        DO UNTIL i& = Start&            Parent& = Start& + (i& - Start&) \ 2 ' Get the subscript for the parent node.            ' The value at the current node is still smaller than the value at            ' its parent node, so swap these two array elements:            IF Array(i&) < Array(Parent&) THEN                SWAP Array(Parent&), Array(i&)                i& = Parent&                ' Otherwise, the element has reached its proper place in the heap,                ' so exit this procedure:            ELSE                EXIT DO            END IF        LOOPEND SELECTEND SUB'****************************************'* 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.'****************************************SUB IntroSort (Array() AS DOUBLE, start&, finish&, order&)STATIC IntroSortlevel&STATIC MaxRecurseLevel&MaxRecurseLevel& = 15IF start& < finish& THEN    IF finish& - start& > 31 THEN        IF IntroSortlevel& > MaxRecurseLevel& THEN            HeapSort Array(), start&, finish&, order&        ELSE            QuickSortIJ Array(), start&, finish&, i&, j&, order&            IntroSortlevel& = IntroSortlevel& + 1            IntroSort Array(), start&, j&, order&            IntroSort Array(), i&, finish&, order&            IntroSortlevel& = IntroSortlevel& - 1        END IF    ELSE        InsertionSort Array(), start&, finish&, order&    END IFEND IFEND SUBSUB QuickSortIJ (Array() AS DOUBLE, start&, finish&, i&, j&, order&)DIM Compare AS DOUBLE '* MUST be the same type as array()i& = start&j& = finish&Compare = Array(i& + (j& - i&) \ 2)SELECT CASE order&    CASE 1        DO            DO WHILE Array(i&) < Compare                i& = i& + 1            LOOP            DO WHILE Array(j&) > Compare                j& = j& - 1            LOOP            IF i& <= j& THEN                IF i& <> j& THEN                    SWAP Array(i&), Array(j&)                END IF                i& = i& + 1                j& = j& - 1            END IF        LOOP UNTIL i& > j&    CASE ELSE        DO            DO WHILE Array(i&) > Compare                i& = i& + 1            LOOP            DO WHILE Array(j&) < Compare                j& = j& - 1            LOOP            IF i& <= j& THEN                IF i& <> j& THEN                    SWAP Array(i&), Array(j&)                END IF                i& = i& + 1                j& = j& - 1            END IF        LOOP UNTIL i& > j&END SELECTEND SUB'**********************'* the standard array scanning technique to find array() min and max values from start& to finish&'**********************SUB GetMinMaxArray (Array() AS DOUBLE, start&, finish&, MinIndex&, MaxIndex&)MinIndex& = start&MaxIndex& = start&FOR s& = start& + 1 TO finish&    IF Array(s&) < Array(MinIndex&) THEN MinIndex& = s&    IF Array(s&) > Array(MaxIndex&) THEN MaxIndex& = s&NEXTEND SUB'*********************************'* 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 MergeTwoWay (Array() AS DOUBLE, start&, finish&, order&)middle& = start& + (finish& - start&) \ 2MergeSort Array(), start&, middle&, order&MergeSort Array(), middle& + 1, finish&, order&IF order& = 1 THEN    EfficientMerge Array(), start&, finish&, order&ELSE    MergeRoutine Array(), start&, finish&, order&END IFEND SUB'**********************'* Standardized Merge procedure. Assumes array(start to middle), (middle+1 to finish) is already sorted on arrival.'**********************SUB MergeRoutine (Array() AS DOUBLE, start&, finish&, order&)length& = finish& - start&middle& = start& + length& \ 2DIM temp(0 TO length&)FOR i& = 0 TO length&    temp(i&) = Array(start& + i&)NEXT'* 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.SELECT CASE order&    CASE 1        mptr& = 0        sptr& = middle& - start& + 1        FOR i& = 0 TO length&            IF sptr& <= finish& - start& THEN                IF mptr& <= middle& - start& THEN                    IF temp(mptr&) > temp(sptr&) THEN                        Array(i& + start&) = temp(sptr&)                        sptr& = sptr& + 1                    ELSE                        Array(i& + start&) = temp(mptr&)                        mptr& = mptr& + 1                    END IF                ELSE                    Array(i& + start&) = temp(sptr&)                    sptr& = sptr& + 1                END IF            ELSE                Array(i& + start&) = temp(mptr&)                mptr& = mptr& + 1            END IF        NEXT    CASE ELSE        mptr& = 0        sptr& = middle& - start& + 1        FOR i& = 0 TO length&            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                        Array(i& + start&) = temp(sptr&)                        sptr& = sptr& + 1                    ELSE                        Array(i& + start&) = temp(mptr&)                        mptr& = mptr& + 1                    END IF                ELSE                    Array(i& + start&) = temp(sptr&)                    sptr& = sptr& + 1                END IF            ELSE                Array(i& + start&) = temp(mptr&)                mptr& = mptr& + 1            END IF        NEXTEND SELECTERASE tempEND SUB'*******************'* Checks for elements that are not strictly descending or ascending in array().'* Equal elements do not trigger an error as technically, they are sorted.'* if SequenceCheck& < finish&, a sequence error occurred at the index returned by'* function SequenceCheck&'*******************FUNCTION SequenceCheck& (Array() AS DOUBLE, start&, finish&, order&)SequenceCheck& = start&i& = start&SELECT CASE order&    CASE 1        FOR j& = start& + 1 TO finish&            IF Array(j&) > Array(i&) THEN                i& = j& '            ELSEIF Array(j&) < Array(i&) THEN                SequenceCheck& = j&                EXIT FUNCTION            END IF        NEXT    CASE ELSE        FOR j& = start& + 1 TO finish&            IF Array(j&) < Array(i&) THEN                i& = j&            ELSEIF Array(j&) > Array(i&) THEN                SequenceCheck& = j&                EXIT FUNCTION            END IF        NEXTEND SELECTSequenceCheck& = finish&END FUNCTION'***************************************************************************'* string-specific code'***************************************************************************SUB FlashString (Strarray() AS STRING, start&, finish&, order&)TYPE FlashRec    Number AS _INTEGER64    Index AS LONGEND TYPEREDIM FlashStringArray(start& TO finish&) AS FlashRecDIM shift##(0 TO 7)IF order& = 1 THEN    shift##(7) = 1    FOR z% = 6 TO 0 STEP -1        shift##(z%) = shift##(z% + 1) * 256    NEXTELSE    shift##(0) = 1    FOR z% = 1 TO 7        shift##(z%) = shift##(z% - 1) * 256    NEXTEND IFFOR s& = start& TO finish&    acc## = 0    WHILE z% < 8        zp% = z% + 1        p\$ = MID\$(Strarray(s&), zp%, 1)        IF p\$ > "" THEN            acc## = acc## + shift##(z%) * ASC(p\$)            z% = zp%        ELSE            EXIT WHILE        END IF    WEND    FlashStringArray(s&).Number = acc##    FlashStringArray(s&).Index = s&NEXTflashSORTType FlashStringArray(), start&, finish&, order&END SUB'************************'* FlashSort() refactored to indicate where variable changes are necessary to be'* correct for the type of array being sorted. In this case character strings'************************SUB flashSORTType (Array() AS FlashRec, start AS DOUBLE, finish AS DOUBLE, order AS _BYTE)'* change these:DIM hold AS FlashRecDIM flash AS FlashRecDIM ANMiN AS FlashRec'* to the same type as the array being sorted'* change these:DIM KIndex AS _UNSIGNED LONGDIM MIndex AS _UNSIGNED LONGDIM SIndex AS _UNSIGNED LONG'* to long for qbxx as qbxx has no _unsigned types'* the original ratio was .125 but i kept getting array bounds errorsMIndex = (INT(.128 * (finish - start + 1)) + 1) OR 2'* change these:DIM FlashTrackL(0 TO MIndex) AS DOUBLEDIM FlashI AS DOUBLEDIM FlashJ AS DOUBLEDIM NextFlashJ AS DOUBLEDIM FlashNMove AS DOUBLEDIM MaxValueIndex AS DOUBLEDIM FinishMinusOne AS DOUBLE'* 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 Array() with start to finish elements by use of' index vector FlashTrackL() with MIndex elements, with MIndex around .128(finish-start).' Translation of Karl-Dietrich Neubert's FlashSort' algorithm into BASIC by Erdmann Hess.' Generalized Numeric/String 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 = Array(start)MaxValueIndex = startFOR FlashI = start TO finish    IF (Array(FlashI).Number > Array(MaxValueIndex).Number) THEN MaxValueIndex = FlashI    IF (Array(FlashI).Number < ANMiN.Number) THEN        ANMiN = Array(FlashI)        SWAP Array(start), Array(FlashI)    END IFNEXT FlashIIF ANMiN.Number = Array(MaxValueIndex).Number THEN    '* this is a monotonic sequence array and by definition is already sorted    EXIT SUBEND IFDIM FlashTrackL(MIndex)FlashC1 = (MIndex - 1) / (Array(MaxValueIndex).Number - ANMiN.Number)FOR FlashI = start + 1 TO finish    KIndex = INT(FlashC1 * (Array(FlashI).Number - ANMiN.Number)) + 1    FlashTrackL(KIndex) = FlashTrackL(KIndex) + 1NEXTFOR KIndex = LBOUND(FlashTrackL) + 1 TO MIndex    FlashTrackL(KIndex) = FlashTrackL(KIndex) + FlashTrackL(KIndex - 1)NEXT KIndexREM ==================== PERMUTATION ================FlashNMove = 0FlashJ = start + 1KIndex = MIndexFinishMinusOne = finish - 1SWAP Array(finish), Array(MaxValueIndex)WHILE (FlashNMove < FinishMinusOne)    WHILE (FlashJ > FlashTrackL(KIndex))        FlashJ = FlashJ + 1        KIndex = INT(FlashC1 * (Array(FlashJ).Number - ANMiN.Number)) + 1    WEND    flash = Array(FlashJ)    DO        IF (FlashJ = (FlashTrackL(KIndex) + 1)) THEN            EXIT DO        ELSE            IF FlashNMove < (FinishMinusOne) THEN                KIndex = INT(FlashC1 * (flash.Number - ANMiN.Number)) + 1                hold = Array(FlashTrackL(KIndex))                Array(FlashTrackL(KIndex)) = flash                flash = hold                FlashTrackL(KIndex) = FlashTrackL(KIndex) - 1                FlashNMove = FlashNMove + 1            ELSE                EXIT DO            END IF        END IF    LOOPWEND'================= Insertion Sort============'************************'* have to use adapted InsertionSort for TYPEd array'************************FOR SIndex = LBOUND(FlashtrackL) + 1 TO MIndex    '* sort subranges    FOR FlashI = FlashTrackL(SIndex) - 1 TO FlashTrackL(SIndex - 1) STEP -1        IF (Array(FlashI + 1).Number < Array(FlashI).Number) THEN            hold = Array(FlashI)            NextFlashJ = FlashI            DO                FlashJ = NextFlashJ                IF FlashJ < FlashTrackL(SIndex) THEN                    NextFlashJ = FlashJ + 1                    IF (Array(NextFlashJ).Number < hold.Number) THEN                        SWAP Array(FlashJ), Array(NextFlashJ)                    ELSE                        EXIT DO                    END IF                ELSE                    EXIT DO                END IF            LOOP            Array(FlashJ) = hold        END IF    NEXT    '* 914k/Ghz when it reaches this point, assuming this array is mostly sorted.NEXTFOR s& = start& TO finish&    SWAP StrArray(s&), StrArray(Array(s&).Index)NEXTFOR s& = start& TO finish& - 1    FOR t& = s& + 1 TO finish&        IF StrArray(s&) > StrArray(s& + 1) THEN            SWAP StrArray(s&), StrArray(s& + 1)        ELSE            EXIT FOR        END IF    NEXTNEXTIF order <> 1 THEN    IF order <> 0 THEN        FlashI = start        FlashJ = finish        WHILE FlashI < FlashJ            SWAP StrArray(FlashI), StrArray(FlashJ)            FlashI = FlashI - 1            FlashJ = FlashJ - 1        WEND    END IFEND IFEND SUB'*******************'* PrimeGapSort uses PrimeNumber&() function to calculate the prime number less than or equal to the gap'* this is a variation of shellsort. Invented by CodeGuy'*******************SUB primeGapSort2 (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        gap& = (finish& - start& + 1)        DO            FOR i& = start& TO finish& - gap&                IF Array(i&) > Array(i& + gap&) THEN                    SWAP Array(i&), Array(i& + gap&)                END IF            NEXT            gap& = primeNumber&(gap& * 0.727)        LOOP WHILE gap& > 1        InsertionSort Array(), start&, finish&, order&    CASE ELSE        gap& = (finish& - start& + 1)        DO            FOR i& = start& TO finish& - gap&                IF Array(i&) < Array(i& + gap&) THEN                    SWAP Array(i&), Array(i& + gap&)                END IF            NEXT            gap& = primeNumber&(gap& * 0.727)        LOOP WHILE gap& > 1        InsertionSort Array(), start&, finish&, order&END SELECTEND SUB'*******************************'* finds the first prime less than a& -- thanks Zom-B!'*******************************FUNCTION primeNumber& (a&)' 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 firstCall%STATIC pps%() 'Previous Prime in Sequence. Contains about 59.9% of all primes modulo 30.'* wheel factorization by Zom-BIF firstCall% = 0 THEN    firstCall% = -1    REDIM pps%(0 TO 29)    ' 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) = 23END IFb& = a& + 1c& = (b& \ 30) * 30: b& = c& + pps%(b& - c&)div& = 3DO    IF b& MOD div& THEN        IF b& / div& < div& THEN            EXIT DO        ELSE            div& = div& + 2        END IF    ELSE        c& = (b& \ 30) * 30: b& = c& + pps%(b& - c&)        div& = 3    END IFLOOPprimeNumber& = b&END FUNCTION'*******************'* CombSort is the same as shellsort except a reduction factor of 1.3'*******************SUB CombSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE finish& - start&    CASE 1        IF Array(start&) > Array(finish&) THEN            IF order& = 1 THEN                SWAP Array(start&), Array(finish&)            END IF        END IF    CASE IS > 1        IF order& = 1 THEN            ShellSortGap& = INT(10 * (finish& - start&) / 13)            DO                IF ShellSortGap& > 1 THEN                    LoopCount& = 0                    xstart& = start&                    xfinish& = finish& - ShellSortGap&                    MaxPasses& = (finish& - start&) \ ShellSortGap&                    DO                        xfirst& = xfinish&                        FOR ShellSortS& = xstart& TO xfinish&                            IF Array(ShellSortS&) > Array(ShellSortS& + ShellSortGap&) THEN                                SWAP Array(ShellSortS&), Array(ShellSortS& + ShellSortGap&)                                Last& = ShellSortS&                                IF ShellSortS& < xfirst& THEN                                    xfirst& = ShellSortS&                                END IF                            END IF                        NEXT                        xfinish& = Last&                        xstart& = xfirst&                        LoopCount& = LoopCount& + 1                    LOOP WHILE LoopCount& < MaxPasses& AND (xfinish& - xstart&) >= ShellSortGap&                    ShellSortGap& = INT(10 * (ShellSortGap& / 13))                ELSE                    InsertionSort Array(), start&, finish&, order&                    EXIT DO                END IF            LOOP        ELSE            ShellSortGap& = INT(10 * (finish& - start&) / 13)            DO                IF ShellSortGap& > 1 THEN                    LoopCount& = 0                    xstart& = start&                    xfinish& = finish& - ShellSortGap&                    MaxPasses& = (finish& - start&) \ ShellSortGap&                    DO                        xfirst& = xfinish&                        FOR ShellSortS& = xstart& TO xfinish&                            IF Array(ShellSortS&) < Array(ShellSortS& + ShellSortGap&) THEN                                SWAP Array(ShellSortS&), Array(ShellSortS& + ShellSortGap&)                                Last& = ShellSortS&                                IF ShellSortS& < xfirst& THEN                                    xfirst& = ShellSortS&                                END IF                            END IF                        NEXT                        xfinish& = Last&                        xstart& = xfirst&                        LoopCount& = LoopCount& + 1                    LOOP WHILE LoopCount& < MaxPasses& AND (xfinish& - xstart&) >= ShellSortGap&                    ShellSortGap& = INT(10 * (ShellSortGap& / 13))                ELSE                    InsertionSort Array(), start&, finish&, order&                    EXIT DO                END IF            LOOP        END IFEND SELECTEND SUB'********************************'* 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.'********************************SUB EfficientMerge (right() AS DOUBLE, start&, finish&, order&)half& = start& + (finish& - start&) \ 2REDIM 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&)NEXTSELECT CASE order&    CASE 1        i& = start&        j& = half& + 1        insert& = start&        DO            IF i& > half& THEN '* left() exhausted                IF j& > finish& THEN '* right() exhausted                    EXIT DO                ELSE                    '* stuff remains in right to be inserted, so flush right()                    WHILE j& <= finish&                        right(insert&) = right(j&)                        j& = j& + 1                        insert& = insert& + 1                    WEND                    EXIT DO                    '* and exit                END IF            ELSE                IF j& > finish& THEN                    WHILE i& < LoadLeft&                        right(insert&) = left(i&)                        i& = i& + 1                        insert& = insert& + 1                    WEND                    EXIT DO                ELSE                    IF right(j&) < left(i&) THEN                        right(insert&) = right(j&)                        j& = j& + 1                    ELSE                        right(insert&) = left(i&)                        i& = i& + 1                    END IF                    insert& = insert& + 1                END IF            END IF        LOOP    CASE ELSE        i& = half&        j& = finish&        insert& = finish&        DO            IF i& < start& THEN '* left() exhausted                IF j& < half& + 1 THEN '* right() exhausted                    EXIT DO                ELSE                    '* stuff remains in right to be inserted, so flush right()                    WHILE j& >= half&                        right(insert&) = right(j&)                        j& = j& - 1                        insert& = insert& - 1                    WEND                    EXIT DO                    '* and exit                END IF            ELSE                IF j& < half& + 1 THEN                    WHILE i& >= start&                        right(insert&) = left(i&)                        i& = i& - 1                        insert& = insert& - 1                    WEND                    EXIT DO                ELSE                    IF left(i&) > right(j&) THEN                        right(insert&) = right(j&)                        j& = j& - 1                    ELSE                        right(insert&) = left(i&)                        i& = i& - 1                    END IF                    insert& = insert& - 1                END IF            END IF        LOOPEND SELECTERASE leftEND SUB'**********************'* 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.'**********************SUB SelectionSort (array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        FOR s& = start& TO finish& - 1            u& = s&            FOR t& = s& + 1 TO finish&                IF array(t&) < array(u&) THEN                    u& = t&                END IF            NEXT            IF u& <> s& THEN                SWAP array(s&), array(u&)            END IF        NEXT    CASE ELSE        FOR s& = start& TO finish& - 1            u& = s&            FOR t& = s& + 1 TO finish&                IF array(t&) > array(u&) THEN                    u& = t&                END IF            NEXT            IF u& <> s& THEN                SWAP array(s&), array(u&)            END IF        NEXTEND SELECTEND SUB'********************'* are writes to memory or disk time-consuming? this algorithm sorts, minimizing writes'********************SUB cycleSort (array() AS DOUBLE, start&, finish&, order&)length& = finish& - start&IF length& = 0 THEN EXIT SUBDIM item AS DOUBLE '* MUST be same size and/or type as array() elementDIM position AS LONG '* same type as variable used for array index -- usually kept at LONG'* DIM writes AS LONG'* scan array() for cycles to rotateFOR cycleStart& = start& TO finish& - 1    item = array(cycleStart)    '* find where to put the item    position& = cycleStart&    IF order& = 1 THEN        FOR i& = cycleStart& + 1 TO finish&            IF array(i&) < item THEN position = position + 1        NEXT    ELSE        FOR i& = cycleStart& + 1 TO finish&            IF array(i&) > item THEN position = position + 1        NEXT    END IF    '* 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 = array(position)            position = position + 1        WEND        SWAP array(position), item        '* writes=writes+1        'rotate the rest of the cycle        WHILE position <> cycleStart&            '* Find where to put the item            position = cycleStart&            IF order& = 1 THEN                FOR i& = cycleStart& + 1 TO finish&                    IF array(i&) < item THEN position = position + 1                NEXT            ELSE                FOR i& = cycleStart& + 1 TO finish&                    IF array(i&) > item THEN position = position + 1                NEXT            END IF            ' Put the item there or right after any duplicates            WHILE item = array(position)                position = position + 1            WEND            SWAP array(position), item            '* writes=writes+1        WEND    END IFNEXTEND SUB'**********************'* this is dl shell's sort but modified for faster running time than standard shellsort.'**********************SUB shellSortMetzler (array() AS DOUBLE, start&, finish&, order&)DIM b AS DOUBLESELECT CASE order&    CASE 1        m& = metzler&(start&, finish&)        WHILE m& > 0            FOR j& = start& TO finish& - m&                l& = j& + m&                b = array(l&)                FOR i& = j& TO start& STEP -m&                    IF array(i&) > b THEN                        SWAP array(i& + m&), array(i&)                        l& = i&                    ELSE                        i& = start&                    END IF                NEXT                array(l&) = b            NEXT            m& = (m& - 1) \ 3        WEND    CASE ELSE        m& = metzler&(start&, finish&)        WHILE m& > 0            FOR j& = start& TO finish& - m&                l& = j& + m&                b = array(l&)                FOR i& = j& TO start& STEP -m&                    IF array(i&) < b THEN                        SWAP array(i& + m&), array(i&)                        l& = i&                    ELSE                        i& = start&                    END IF                NEXT                array(l&) = b            NEXT            m& = (m& - 1) \ 3        WENDEND SELECTEND SUBFUNCTION metzler& (a&, b&)x& = (b& - a& + 1) \ 3s& = 0DO    IF x& < 1 THEN        EXIT DO    ELSE        s& = 3 * s& + 1        x& = (x& - 1) \ 3    END IFLOOPmetzler& = s&END FUNCTION'*********************************'* 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&)DIM addtoskip5(0 TO 3) AS LONG'* used correctly, this array will eliminate all integers of the form 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) = 2addtoskip5(1) = 4addtoskip5(2) = 2addtoskip5(3) = 2Primes(0) = 2s& = 1r& = 2p& = 0NPrimes& = 1DO    s& = s& + addtoskip5(p&)    p& = (p& + 1) MOD 4    div& = 3    r& = 1    DO        IF (s& / div&) < div& THEN            '* this is a prime            Primes(NPrimes&) = s&            NPrimes& = NPrimes& + 1            EXIT DO        ELSE            IF s& MOD div& THEN                div& = div& + addtoskip5(r&)                r& = (r& + 1) MOD 4            ELSE                EXIT DO            END IF        END IF    LOOPLOOP UNTIL NPrimes& > UBOUND(Primes) OR s& > MaximumN&REDIM _PRESERVE Primes(0 TO NPrimes& - 1)END SUB'************************'* the original invention by CodeGuy.'* competitive time to MergeSort'************************SUB PrimeGapSort (array() AS DOUBLE, start&, finish&, order&)'REDIM Primes(0 TO finish& - start& + 1) AS LONG'PrimeGen Primes(), finish& - start& + 1, NPrimes&IF order& = 1 THEN    Gap& = finish& - start&    b& = NPrimes&    DO        t& = INT(727 * (Gap& / 1000))        a& = LBOUND(primes)        DO            c& = a& + (b& - a&) \ 2            IF primes(c&) > t& THEN                b& = c& - 1            ELSE                a& = c&            END IF        LOOP WHILE b& > a& + 1        b& = c& - 1        Gap& = primes(c&)        FOR s& = start& TO finish& - Gap&            IF array(s&) > array(s& + Gap&) THEN                SWAP array(s&), array(s& + Gap&)            END IF        NEXT    LOOP WHILE c& > 0ELSE    Gap& = finish& - start&    b& = NPrimes&    DO        t& = INT(727 * (Gap& / 1000))        a& = LBOUND(primes)        DO            c& = a& + (b& - a&) \ 2            IF primes(c&) > t& THEN                b& = c& - 1            ELSE                a& = c&            END IF        LOOP WHILE b& > a& + 1        b& = c& - 1        Gap& = primes(c&)        FOR s& = start& TO finish& - Gap&            IF array(s&) < array(s& + Gap&) THEN                SWAP array(s&), array(s& + Gap&)            END IF        NEXT    LOOP WHILE c& > 0END IFInsertionSort array(), start&, finish&, order&END SUB'*****************'* as long as a stable subsorting algorithm is used, PostSort remains stable.'* Surprisingly as NumPostBins& increases, the speed increases.'*****************SUB PostSort (array() 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 array(), start&, finish&, IndexMin&, IndexMax&IF IndexMin& = IndexMax& THEN EXIT SUBNumPostBins& = 0ps& = 1.1 * (finish& - start& + 1) / (NumPostBins& + 1 / (NumPostBins& + 1))REDIM PostArray(0 TO NumPostBins&, 0 TO ps&) AS DOUBLEREDIM Counts(0 TO NumPostBins&) AS LONGRange# = array(IndexMax&) - array(IndexMin&)IF order& = 1 THEN    FOR s& = start& TO finish&        Bin& = NumPostBins& * (array(s&) - array(IndexMin&)) / Range#        PostArray(Bin&, Counts(bim&)) = array(s&)        Counts(Bin&) = Counts(Bin&) + 1    NEXT    TotalInserted& = start&    FOR a& = 0 TO NumPostBins&        IF Counts(a&) > 0 THEN            lastinsert& = Totalnserted&            FOR q& = 0 TO Counts(a&) - 1                array(TotalInserted&) = PostArray(a&, q&)                TotalInserted& = TotalInserted& + 1            NEXT            MergeSort array(), lastinsert&, TotalInserted& - 1, order&        END IF    NEXTELSE    FOR s& = start& TO finish&        Bin& = NumPostBins& * (array(IndexMax&) - array(s&)) / Range#        PostArray(Bin&, Counts(bim&)) = array(s&)        Counts(Bin&) = Counts(Bin&) + 1    NEXT    TotalInserted& = start&    FOR a& = 0 TO NumPostBins&        IF Counts(a&) > 0 THEN            lastinsert& = Totalnserted&            FOR q& = 0 TO Counts(a&) - 1                array(TotalInserted&) = PostArray(a&, q&)                TotalInserted& = TotalInserted& + 1            NEXT            MergeSort array(), lastinsert&, TotalInserted& - 1, order&        END IF    NEXTEND IFERASE PostArrayERASE CountsEND SUB'******************************************'* 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.'******************************************SUB HashListSort (array() AS DOUBLE, start&, finish&, order&)'* must be same type as arrayDIM PNum AS DOUBLEDIM Delta AS DOUBLE'* must be same type as arrayGetMinMaxArray array(), start&, finish&, ptrmin&, ptrmax&IF array(ptrmin&) = array(ptrmax&) THEN EXIT SUBDelta = array(ptrmax&) - array(ptrmin&)Probe& = primeNumber&(1.25# * (finish& - start&)) - 1REDIM HashTable(0 TO Probe&) AS DOUBLEREDIM Count(0 TO Probe&) AS LONGFOR s& = start& TO finish&    PNum = array(s&) - array(ptrmin&)    f& = INT(Probe& * PNum / Delta)    DO        IF f& > Probe& THEN            f& = f& - Probe&        END IF        IF f& < 0 THEN            f& = f& + Probe&        END IF        IF HashTable(f&) = array(s&) THEN            Count(f&) = Count(f&) + 1            EXIT DO        ELSE            IF Count(f&) = 0 THEN                HashTable(f&) = array(s&)                Count(f&) = 1                EXIT DO            END IF        END IF        f& = f& + 1    LOOPNEXTinserted& = start&IF order& = 1 THEN    FOR s& = 0 TO Probe&        WHILE Count(s&) > 0            array(inserted&) = HashTable(s&)            inserted& = inserted& + 1            Count(s&) = Count(s&) - 1        WEND    NEXTELSE    FOR s& = Probe& TO 0 STEP -1        WHILE Count(s&) > 0            array(inserted&) = HashTable(s&)            inserted& = inserted& + 1            Count(s&) = Count(s&) - 1        WEND    NEXTEND IFERASE CountERASE HashTableInsertionSort array(), start&, finish&, order&END SUB'* This is the original version of the faster min-max vector searchSUB GetMinMax (array() AS LONG, Start&, finish&, minmax AS MinMaxRec)IF ((finish& - Start&) MOD 2) THEN    minmax.min = array(Start&)    minmax.max = array(Start&)    i& = Start& + 1ELSE    IF (array(Start&) > array(finish&)) THEN        minmax.max = array(Start&)        minmax.min = array(finish&)    ELSE        minmax.min = array(finish&)        minmax.max = array(Start&)    END IF    i& = Start& + 2END IF 'WHILE (i& < finish&)    IF (array(i&) > array(i& + 1)) THEN        IF (array(i&) > minmax.max) THEN            minmax.max = array(i&)        END IF        IF (array(i& + 1) < minmax.min) THEN            minmax.min = array(i& + 1)        END IF    ELSE        IF (array(i& + 1) > minmax.max) THEN            minmax.max = array(i& + 1)        END IF        IF (array(i&) < minmax.min) THEN            minmax.min = array(i&)        END IF    END IF    i& = i& + 2WENDEND SUB'*****************'* 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 (a() AS DOUBLE, start&, finish&, order&)ArrayIsInteger a(), start&, finish&, errindex&, errcon&IF errcon& THEN    '* use another stable sort and sort anyway    MergeSort a(), start&, finish&, order&ELSE    GetMinMaxArray a(), start&, finish&, minptr&, maxptr&    IF minptr& = maxptr& THEN EXIT SUB '* no div0 bombs    delta# = a(maxptr&) - a(minptr&)    DIM pow2 AS _UNSIGNED _INTEGER64    DIM NtmpN AS _UNSIGNED _INTEGER64    REDIM ct&(-1 TO 1)    REDIM Radixarray(-1 TO 1, finish& - start&) AS DOUBLE    REDIM Int64MaxShift AS _INTEGER64    Int64MaxShift = 2 ^ 64    pow2 = 1    FOR bits& = 0 TO 63        FOR i& = start& TO finish&            NtmpN = Int64MaxShift * (a(i&) - a(minptr&)) / (delta#)            IF NtmpN AND pow2 THEN                tmpradix% = 1            ELSE                tmpradix% = 0            END IF            Radixarray(tmpradix%, ct&(tmpradix%)) = a(i&)            ct&(tmpradix%) = ct&(tmpradix%) + 1        NEXT        c& = start&        FOR i& = 1 TO -1 STEP -1            FOR j& = 0 TO ct&(i&) - 1                a(c&) = Radixarray(i&, j&)                c& = c& + 1            NEXT            ct&(i&) = 0        NEXT        pow2 = pow2 * 2    NEXT    ERASE Radixarray, ct&    IF order& = 1 THEN        StableInvert a(), start&, finish&, 1    END IF    InsertionSort a(), start&, finish&, order&END IFEND SUB'*****************'* Used by RadixSort, which requires integer-domain arrays to function properly'*****************SUB ArrayIsInteger (array() AS DOUBLE, start&, finish&, errorindex&, IsInt&)IsInt& = 1errorindex& = start&FOR IsIntegerS& = start& TO finish&    IF array(IsIntegerS&) MOD 1 THEN        errorindex& = IsIntegerS&        IsInt& = 0        EXIT FUNCTION    END IFNEXTEND FUNCTION'*****************'* Able to sort ALL the data, even spread out over numerous processors and computers if so desired'* this is the single-cpu version. Many GPU-as-CPU languages use this sorting method as it can be'* run in parallel among many CPU's and computers. - The limitation is Power-of-2 size arrays only.'* Invented by Kenneth E. Batcher. Visualized, it is beautiful, IMHO.'*****************SUB BatcherOddEvenMergeSort (Array() AS DOUBLE, Start&, Finish&)IF (Finish& > 1) THEN    m& = (Finish& + (Finish& MOD 2)) \ 2    BatcherOddEvenMergeSort Array(), Start&, m&    BatcherOddEvenMergeSort Array(), Start& + m&, m&    BatcherOddEvenMerge Array(), Start&, Finish&, 1END IFEND SUBSUB BatcherOddEvenMerge (Array() AS DOUBLE, Start&, Finish&, r&)m& = r& * 2IF (m& < Finish&) AND m& > 0 THEN    BatcherOddEvenMerge Array(), Start&, Finish&, m&    BatcherOddEvenMerge Array(), Start& + r&, Finish&, m&    i& = Start& + r&    DO        IF i& + m& > Start& + Finish& THEN            EXIT DO        ELSE            IF Array(i&) > Array(i& + r&) THEN                SWAP Array(i&), Array(i& + r&)            END IF            i& = i& + m&        END IF    LOOPELSE    IF Array(Start&) > Array(Start& + r&) THEN        SWAP Array(Start&), Array(Start& + r&)    END IFEND IFEND SUB'**********************'* Theoretically, this allows a single pass of an array Gap& elements apart.'* The running time is similar to ShellSort. (is not stable, same as multiple pass ShellSort)'* this was part of the inspiration behind PrimeGapSort(), invented by CodeGuy'**********************SUB SinglePassShellSort (array() AS DOUBLE, start&, finish&, order&)Gap& = (finish& - start&)DO    SELECT CASE order&        CASE 1            FOR c& = start& TO finish& - Gap&                IF array(c&) > array(c& + Gap&) THEN                    SWAP array(c&), array(c& + Gap&)                END IF            NEXT        CASE ELSE            FOR c& = start& TO finish& - Gap&                IF array(c&) < array(c& + Gap&) THEN                    SWAP array(c&), array(c& + Gap&)                END IF            NEXT    END SELECT    Gap& = Gap& / 1.247#LOOP UNTIL Gap& < 1'* By this time, the array is mostly ordered and InsertionSort is a perfectly suited finishing run.InsertionSort array(), start&, finish&, order&END SUB'*********************'* 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.'*********************SUB BitonicSort (a() AS DOUBLE, lo&, n&, dir&)IF (n& > 1) THEN    m& = n& \ 2    BitonicSort a(), lo&, m&, NOT dir&    BitonicSort a(), lo& + m&, n& - m&, dir&    BitonicMerge a(), lo&, n&, dir&END IFEND SUBSUB BitonicMerge (a() AS DOUBLE, lo&, n&, dir&)IF (n& > 1) THEN    m& = greatestPowerOfTwoLessThan&(n&)    FOR i& = lo& TO lo& + n& - m&        BitonicMergeCompare a(), i&, i& + m&, dir&    NEXT    BitonicMerge a(), lo&, m&, dir&    BitonicMerge a(), lo& + m&, n& - m&, dir&END IFEND SUBSUB BitonicMergeCompare (a() AS DOUBLE, i&, j&, dir&)IF (dir& = (a(i&) > a(j&))) THEN    BitonicMergeExchange a(), i&, j&END IFEND SUBSUB BitonicMergeExchange (a() AS DOUBLE, i&, j&)SWAP a(i&), a(j&)'t = a(i)'a(i) = a(j)'a(j) = tEND SUBFUNCTION greatestPowerOfTwoLessThan& (n&)k& = 1WHILE (k& < n&)    k& = k& * 2WENDgreatestPowerOfTwoLessThan& = k& / 2END FUNCTION'***********************'* Kth order statistic for array()'* this algorithm also modifies the passed array'**********************SUB QuickSelectRecursive (array() AS LONG, start&, finish&, statistic&)pivotIndex& = QSelectPartitionArray&(array(), start&, finish&)SELECT CASE pivotIndex&    CASE IS < statistic&        QuickSelectRecursive array(), pivotIndex&, finish&, statistic&    CASE IS > statistic&        QuickSelectRecursive array(), start&, pivotIndex&, statistic&    CASE ELSE        EXIT SUBEND SELECTEND SUBFUNCTION QSelectPartitionArray& (array() AS LONG, start&, finish&)'* this declaration MUST be the same type as array()DIM pivot AS LONGpivotIndex& = start& + RND * (finish& - start&)pivot = array(pivotIndex&)'* and a familiar shuffle routine reminiscent of QuickSortSWAP array(pivotIndex&), array(finish&)pivotIndex& = start&FOR i& = start& TO finish&    IF array(i&) < pivot THEN        SWAP array(i&), array(pivotIndex&)        pivotIndex& = pivotIndex& + 1    END IFNEXTSWAP array(pivotIndex&), array(finish&)QSelectPartitionArray& = pivotIndex&END FUNCTIONSUB QuickselectIterative (array() AS LONG, start&, finish&, k&)LStart& = start&LFinish& = finish&pivotIndex = partition(array, LStart&, LFinish&)WHILE (pivotIndex <> k&)    pivotIndex& = QSelectPartitionArray&(array(), LStart&, LFinish&)    IF (pivotIndex& < k&) THEN        LStart& = pivotIndex&    ELSEIF (pivotIndex > kK) THEN        LFinish& = pivotIndex&    END IFWENDEND FUNCTION'***********************************'* 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 ArrayGetMinMax (array() AS DOUBLE, start&, finish&, ArrayMinIndex&, ArrayMaxIndex&)IF ((finish& - start&) MOD 2) THEN    '* there is an even number of elements past array(start&)    ArrayMinIndex& = start&    ArrayMaxIndex& = start&    i& = 1ELSE    IF (array(0) > array(1)) THEN        ArrayMaxIndex& = start&        ArrayMinIndex& = start& + 1    ELSE        ArrayMinIndex& = start&        ArrayMaxIndex& = start& + 1    END IF    i& = 2END IF 'WHILE (i& < finish&) '* also corrected -- originally an undeclared n, which was finish&, irrespective of start&    IF (array(i&) > array(i& + 1)) THEN        IF array(i&) > array(ArrayMaxIndex&) THEN            ArrayMaxIndex& = i&        END IF        IF array(i& + 1) < array(ArrayMinIndex&) THEN            ArrayMinIndex& = i& + 1        END IF    ELSE        IF array(i& + 1) > array(ArrayMaxIndex&) THEN            ArrayMaxIndex& = i& + 1        END IF        IF array(i&) < array(ArrayMinIndex&) THEN            ArrayMinIndex& = i&        END IF    END IF    i& = i& + 2WENDEND SUB'************************'* the InPlaceMergeSort, extended to qbxx. Added 14 Feb 2018'* The in-place MergeSort algorithm for qbxx, because I could find no reasonable listing. Reasonable = carefully'* coded, commented and tested. In-place simply means there is no auxiliary array necessary. Some Caveats: if the'* array is sorted in the opposing order, it will become an O(n^2) complexity -- for larger N, this means coffee'* break interval for completion. In-place saves memory and potentially time-consuming array copying. The complexity'* for average-case performance is left to debate, but generally agreed O(NLogN), like standard MergeSort().'*************************SUB MergeSortInPlace (Array() AS DOUBLE, start&, finish&, order&)DIM IpmsTemp AS DOUBLE '* MUST be same type as Array()IpmsLo& = start&IpmsHi& = finish&IF (IpmsLo& >= IpmsHi&) THEN    EXIT SUBEND IFIpmsmid& = IpmsLo& + (IpmsHi& - IpmsLo&) \ 2'* Partition Array() into two lists, sorting them recursively (also uses head recursion like stamdard MergeSort())'* sort the first halfMergeSortInPlace Array(), IpmsLo&, Ipmsmid&, order&'* then sort the remainingMergeSortInPlace Array(), Ipmsmid& + 1, IpmsHi&, order&IF order& = 1 THEN    FinishIpmsLo& = Ipmsmid&    startIpmsHi& = Ipmsmid& + 1    WHILE ((IpmsLo& <= FinishIpmsLo&) AND (startIpmsHi& <= IpmsHi&))        IF (Array(IpmsLo&) <= Array(startIpmsHi&)) THEN            '* element in first part of Array() is less, so adjust its index to the next one            IpmsLo& = IpmsLo& + 1        ELSE            '* save the value of the  first element of the second half of array()            IpmsTemp = Array(startIpmsHi&)            '* shift elements to the right            FOR IpmsK& = startIpmsHi& - 1 TO IpmsLo& STEP -1                Array(IpmsK& + 1) = Array(IpmsK&)            NEXT            '* put the temporary hold value where it belongs            Array(IpmsLo&) = IpmsTemp            '* the values for these have shifted right 1, so adjust them            IpmsLo& = IpmsLo& + 1            FinishIpmsLo& = FinishIpmsLo& + 1            startIpmsHi& = startIpmsHi& + 1        END IF    WENDELSE    FinishIpmsLo& = Ipmsmid&    startIpmsHi& = Ipmsmid& + 1    WHILE ((IpmsLo& <= FinishIpmsLo&) AND (startIpmsHi& <= IpmsHi&))        IF (Array(IpmsLo&) >= Array(startIpmsHi&)) THEN            '* element in first part of Array() is less, so adjust its index to the next one            IpmsLo& = IpmsLo& + 1        ELSE            '* save the value of the  first element of the second half of array()            IpmsTemp = Array(startIpmsHi&)            '* shift elements to the right            FOR IpmsK& = startIpmsHi& - 1 TO IpmsLo& STEP -1                Array(IpmsK& + 1) = Array(IpmsK&)            NEXT            '* put the temporary hold value where it belongs            Array(IpmsLo&) = IpmsTemp            '* the values for these have shifted right 1, so adjust them            IpmsLo& = IpmsLo& + 1            FinishIpmsLo& = FinishIpmsLo& + 1            startIpmsHi& = startIpmsHi& + 1        END IF    WENDEND IFEND SUB`
« Last Edit: February 14, 2018, 10:59:18 pm by codeguy »

#### SMcNeill

• Moderator
• Hero Member
• Posts: 6236
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #1 on: August 02, 2017, 07:00:27 am »
Here's my little all purpose sort routine, which you can play around with for speed comparison:

Code: [Select]
`CONST Limit = 10000000DIM Byte_Array(Limit) AS _BYTEDIM Integer_Array(Limit) AS INTEGERDIM Float_Array(Limit) AS _FLOATDIM m AS _MEMPRINT "Seeding arrays with data"FOR i&& = 0 TO Limit 'make some large arrays    Byte_Array(i) = RND * 256    Integer_Array(i) = RND * 65556    Float_Array(i) = RND * 1234567890NEXTPRINT "Sorting Byte Array"t# = TIMERm = _MEM(Byte_Array())Sort mt1# = TIMERPRINT "Sorting Integer Array"m = _MEM(Integer_Array())Sort mt2# = TIMERPRINT "Sorting Float Array (May take a minute)"m = _MEM(Float_Array())Sort mt3# = TIMERPRINT USING "Sorted #,###,###,###,### byte elements in #,###.### seconds"; Limit, t1# - t#PRINT USING "Sorted #,###,###,###,### integer elements in #,###.### seconds"; Limit, t2# - t1#PRINT USING "Sorted #,###,###,###,### float elements in #,###.### seconds"; Limit, t3# - t2#SUB Sort (m AS _MEM)DIM i AS _UNSIGNED LONG\$IF 64BIT THEN    DIM ES AS _INTEGER64, EC AS _INTEGER64\$ELSE    DIM ES AS LONG, EC AS LONG\$END IFIF NOT m.TYPE AND 65536 THEN EXIT SUB 'We won't work without an arrayIF m.TYPE AND 1024 THEN DataType = 10IF m.TYPE AND 1 THEN DataType = DataType + 1IF m.TYPE AND 2 THEN DataType = DataType + 2IF m.TYPE AND 4 THEN IF m.TYPE AND 128 THEN DataType = DataType + 4 ELSE DataType = 3IF m.TYPE AND 8 THEN IF m.TYPE AND 128 THEN DataType = DataType + 8 ELSE DataType = 5IF m.TYPE AND 32 THEN DataType = 6IF m.TYPE AND 512 THEN DataType = 7'Convert our offset data over to something we can work withDIM m1 AS _MEM: m1 = _MEMNEW(LEN(ES))_MEMPUT m1, m1.OFFSET, m.ELEMENTSIZE: _MEMGET m1, m1.OFFSET, ES 'Element Size_MEMPUT m1, m1.OFFSET, m.SIZE: _MEMGET m1, m1.OFFSET, EC 'Element Count will temporily hold the WHOLE array size_MEMFREE m1EC = EC / ES - 1 'Now we take the whole element size / the size of the elements and get our actual element count.  We subtract 1 so our arrays start at 0 and not 1.'And work with it!DIM o AS _OFFSET, o1 AS _OFFSET, counter AS _UNSIGNED LONGSELECT CASE DataType    CASE 1 'BYTE        DIM temp1(-128 TO 127) AS _UNSIGNED LONG        DIM t1 AS _BYTE        i = 0        DO            _MEMGET m, m.OFFSET + i, t1            temp1(t1) = temp1(t1) + 1            i = i + 1        LOOP UNTIL i > EC        i1 = -128        DO            DO UNTIL temp1(i1) = 0                _MEMPUT m, m.OFFSET + counter, i1 AS _BYTE                counter = counter + 1                temp1(i1) = temp1(i1) - 1                IF counter > EC THEN EXIT SUB            LOOP            i1 = i1 + 1        LOOP UNTIL i1 > 127    CASE 2: 'INTEGER        DIM temp2(-32768 TO 32767) AS _UNSIGNED LONG        DIM t2 AS INTEGER        i = 0        DO            _MEMGET m, m.OFFSET + i * 2, t2            temp2(t2) = temp2(t2) + 1            i = i + 1        LOOP UNTIL i > EC        i1 = -32768        DO            DO UNTIL temp2(i1) = 0                _MEMPUT m, m.OFFSET + counter * 2, i1 AS INTEGER                counter = counter + 1                temp2(i1) = temp2(i1) - 1                IF counter > EC THEN EXIT SUB            LOOP            i1 = i1 + 1        LOOP UNTIL i1 > 32767    CASE 3 'SINGLE        DIM T3a AS SINGLE, T3b AS SINGLE        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 4                o1 = m.OFFSET + (i + gap) * 4                IF _MEMGET(m, o, SINGLE) > _MEMGET(m, o1, SINGLE) THEN                    _MEMGET m, o1, T3a                    _MEMGET m, o, T3b                    _MEMPUT m, o1, T3b                    _MEMPUT m, o, T3a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 4 'LONG        DIM T4a AS LONG, T4b AS LONG        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 4                o1 = m.OFFSET + (i + gap) * 4                IF _MEMGET(m, o, LONG) > _MEMGET(m, o1, LONG) THEN                    _MEMGET m, o1, T4a                    _MEMGET m, o, T4b                    _MEMPUT m, o1, T4b                    _MEMPUT m, o, T4a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 5 'DOUBLE        DIM T5a AS DOUBLE, T5b AS DOUBLE        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 8                o1 = m.OFFSET + (i + gap) * 8                IF _MEMGET(m, o, DOUBLE) > _MEMGET(m, o1, DOUBLE) THEN                    _MEMGET m, o1, T5a                    _MEMGET m, o, T5b                    _MEMPUT m, o1, T5b                    _MEMPUT m, o, T5a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 6 ' _FLOAT        DIM T6a AS _FLOAT, T6b AS _FLOAT        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 32                o1 = m.OFFSET + (i + gap) * 32                IF _MEMGET(m, o, _FLOAT) > _MEMGET(m, o1, _FLOAT) THEN                    _MEMGET m, o1, T6a                    _MEMGET m, o, T6b                    _MEMPUT m, o1, T6b                    _MEMPUT m, o, T6a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 7 'String        DIM T7a AS STRING, T7b AS STRING, T7c AS STRING        T7a = SPACE\$(ES): T7b = SPACE\$(ES): T7c = SPACE\$(ES)        gap = EC        DO            gap = INT(gap / 1.247330950103979)            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * ES                o1 = m.OFFSET + (i + gap) * ES                _MEMGET m, o, T7a                _MEMGET m, o1, T7b                IF T7a > T7b THEN                    T7c = T7b                    _MEMPUT m, o1, T7a                    _MEMPUT m, o, T7c                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = false    CASE 8 '_INTEGER64        DIM T8a AS _INTEGER64, T8b AS _INTEGER64        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 8                o1 = m.OFFSET + (i + gap) * 8                IF _MEMGET(m, o, _INTEGER64) > _MEMGET(m, o1, _INTEGER64) THEN                    _MEMGET m, o1, T8a                    _MEMGET m, o, T8b                    _MEMPUT m, o1, T8b                    _MEMPUT m, o, T8a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 11: '_UNSIGNED _BYTE        DIM temp11(0 TO 255) AS _UNSIGNED LONG        DIM t11 AS _UNSIGNED _BYTE        i = 0        DO            _MEMGET m, m.OFFSET + i, t11            temp11(t11) = temp11(t11) + 1            i = i + 1        LOOP UNTIL i > EC        i1 = 0        DO            DO UNTIL temp11(i1) = 0                _MEMPUT m, m.OFFSET + counter, i1 AS _UNSIGNED _BYTE                counter = counter + 1                temp11(i1) = temp11(i1) - 1                IF counter > EC THEN EXIT SUB            LOOP            i1 = i1 + 1        LOOP UNTIL i1 > 255    CASE 12 '_UNSIGNED INTEGER        DIM temp12(0 TO 65535) AS _UNSIGNED LONG        DIM t12 AS _UNSIGNED INTEGER        i = 0        DO            _MEMGET m, m.OFFSET + i * 2, t12            temp12(t12) = temp12(t12) + 1            i = i + 1        LOOP UNTIL i > EC        i1 = 0        DO            DO UNTIL temp12(i1) = 0                _MEMPUT m, m.OFFSET + counter * 2, i1 AS _UNSIGNED INTEGER                counter = counter + 1                temp12(i1) = temp12(i1) - 1                IF counter > EC THEN EXIT SUB            LOOP            i1 = i1 + 1        LOOP UNTIL i1 > 65535    CASE 14 '_UNSIGNED LONG        DIM T14a AS _UNSIGNED LONG, T14b AS _UNSIGNED LONG        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 4                o1 = m.OFFSET + (i + gap) * 4                IF _MEMGET(m, o, _UNSIGNED LONG) > _MEMGET(m, o1, _UNSIGNED LONG) THEN                    _MEMGET m, o1, T14a                    _MEMGET m, o, T14b                    _MEMPUT m, o1, T14b                    _MEMPUT m, o, T14a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0    CASE 18: '_UNSIGNED _INTEGER64        DIM T18a AS _UNSIGNED _INTEGER64, T18b AS _UNSIGNED _INTEGER64        gap = EC        DO            gap = 10 * gap \ 13            IF gap < 1 THEN gap = 1            i = 0            swapped = 0            DO                o = m.OFFSET + i * 8                o1 = m.OFFSET + (i + gap) * 8                IF _MEMGET(m, o, _UNSIGNED _INTEGER64) > _MEMGET(m, o1, _UNSIGNED _INTEGER64) THEN                    _MEMGET m, o1, T18a                    _MEMGET m, o, T18b                    _MEMPUT m, o1, T18b                    _MEMPUT m, o, T18a                    swapped = -1                END IF                i = i + 1            LOOP UNTIL i + gap > EC        LOOP UNTIL gap = 1 AND swapped = 0END SELECTEND SUB`
I don't imagine it'll lose to any other sort routine out there, as long as the user's array is byte, unsigned byte, integer, or unsigned integer size.  As for other data types, it still works as one of the fastest "all purpose" sort routines out there.

Best part??

One sort routine works with nearly ALL data types.  Signed or Unsigned Byte, Integer, Long.  Single, Double, Float.  Fixed Length Strings.  (It won't support variable length strings as _MEM itself doesn't support those as they can move about in memory as needed.)

Just point a mem variable at your array, and then send that variable as the parameter to the sort routine; it'll handle all the rest.

NOTE:  QB64 version 1.1 and lower have a glitch with mem.ELEMENTSIZE and this may not work properly on 64-bit OSes. A fix was pushed into the repo today (08-02-2017), so you may need to grab a fresh copy of the daily build so that it'll work properly on a 64-bit version of QB64.

Note2: Personally, I find this to be the "best" routine for me simply because it works across such a wide range of array variable types.
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #2 on: August 02, 2017, 07:05:38 am »
Thank you Steve. For a while someone has suggested I post up all my Sorting Algorithms code with explanations and analysis. So that's what I'm doing to help create a MASSIVE library of useful and fast sorts all in one convenient library. I a submitting it in qbxx-compatible code because I want it to be usable across different versions of qb/qbxx or easily adaptable even to interpreters. The Flashsort refactored sorts 8388608 double precision in roughly 10s on a 2 GHz machine. I don't know what you've named your sort, SteveMemSort()? I'll take a look at it and judging by its flexibility to work on all data types (I assume C-type struct too (aka TYPE), it will be worthwhile to include. Name it, I'll include it. 57s for 10M DOUBLE. explain how it's smoking on integer and byte. 1,5s for 10M elements.
« Last Edit: August 02, 2017, 07:49:00 am by codeguy »

#### SMcNeill

• Moderator
• Hero Member
• Posts: 6236
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #3 on: August 02, 2017, 07:42:06 am »
Thank you Steve. For a while someone has suggested I post up all my Sorting Algorithms code with explanations and analysis. So that's what I'm doing to help create a MASSIVE library of useful and fast sorts all in one convenient library. I a submitting it in qbxx-compatible code because I want it to be usable across different versions of qb/qbxx or easily adaptable even to interpreters. The Flashsort refactored sorts 8388608 double precision in roughly 10s on a 2 GHz machine. I don't know what you've named your sort, SteveMemSort()? I'll take a look at it and judging by its flexibility to work on all data types (I assume C-type struct too (aka TYPE), it will be worthwhile to include.

It only works on what _MEM will support, so User Defined Types and Variable Length Strings are out.  As for the name of it, I just kept it simple -- SORT -- but you can change it to whatever you feel is best for your purposes.  I'm just too lazy to type in something like SteveMemSort memarray() when I can get away with Sort m() for most of my needs.

By that same lazy logic, it'd also need a little modification to add support for start/stop element limits (such as only sorting element 10-20 of a 100 element array), as I just needed to keep it simple enough to plug-and-play for sorting a whole array at once for my personal needs.

I posted a collection of various sort routines in the past here: http://www.qb64.net/forum/index.php?topic=11446.0  If any of them are useful for you, feel free to take them and make use of them however you feel you want to.

Note:  If you look close, you'll see that these are (mainly) basically Combsort style routines, converted over to use the _MEM commands, as I tend to find it both simple enough to easily implement and fast enough for general use.

Integer/Byte sort however has a nefarious secret behind them, which makes them so blazing fast...

They're not SORT routines at all!  They're basic COUNTER routines.

It's much faster to just count a limited data set, than it is to sort and swap it all about in memory.  Think of it:  A BYTE array can ONLY have results from 0 to 255 stored there.  If we just count the number of 0s, the number of 1s, number of 2s... We then have the array "sorted", without ever having to swap places of anything in memory.

For example, lets say I have 10 elements of a _BIT nature:  0,1,1,0,0,1,0,1,1,1

Now, we can sort those by moving the 0's to the left, and the 1's to the right.  (Most sorts use this generally type of process.)

OR...

We just count the zeros and ones.  Four zeros, Six Ones.  Then we write them back into our array.  0,0,0,0,1,1,1,1,1,1  -- We're not swapping anything back and forth in memory at all!  We just counted and then rebuild the array from scratch... in a fraction of the time.
« Last Edit: August 02, 2017, 07:58:21 am by SMcNeill »
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #4 on: August 02, 2017, 07:51:26 am »
will do. However, some earlier versions of qb64 and especially qbxx aren't gonna like it. whatever.

#### SMcNeill

• Moderator
• Hero Member
• Posts: 6236
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #5 on: August 02, 2017, 08:00:44 am »
Edited my previous post, but you posted back while I was doing so.

You should be able to see why integer and byte are so much faster than any other "sort" method out there, I'd think.

Edit:  Just to show the basic idea:

SELECT CASE DataType
CASE 1 'BYTE
DIM temp1(-128 TO 127) AS _UNSIGNED LONG
DIM t1 AS _BYTE

^ As you can see, we just make a temp array with the limits of what a _BYTE could possibly represent (-128 to 127), and then we count the elements.  (Counter will break if we ever count more than the max limit of what an unsigned long will hold.)

Byte and Integer (signed and unsigned) work like this as we can make an array to count them without using a lot of memory.  LONG and above, however, would just use too large an array to store and count all the elements, so we have to truly sort those -- which is why we see such a difference in speed and performance in the various data types.

I'm confident that my little mem Sort routine won't be beat when it comes to byte/integer arrays...  Just because it really doesn't "sort" those arrays at all.
« Last Edit: August 02, 2017, 08:16:12 am by SMcNeill »
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #6 on: August 06, 2017, 04:13:38 am »
Is your beloved O(NLogN)/mergesort blowing up on you because of memory? Have I got a solution for you. It's called EfficientMerge, well at least in the code update I'll be posting shortly. It requires 1/2 the memory for merging the standard algorithm uses. At very large N, this can mean the difference between success and failure. Sure there are sorts that require no or little extra memory, but they lack stability. So to aid MergeSort to 33% more reliability and range. I'll submit the revised library code when I'm on my laptop. Not only does it save time, it also saves memory. And time? It saves 26&% at 33 million plus. Still, FlashSort remains the reigning champ, beating QuickSort by a margin of 18% in this same range. Because speed matters for huge datasets.

Code: [Select]
`SUB EfficientMergeSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE finish& - start&    CASE IS > 31        middle& = start& + (finish& - start&) \ 2        mergeSort Array(), start&, middle&, order&        mergeSort Array(), middle& + 1, finish&, order&        EfficientMerge Array(), start&, finish&, order&    CASE IS > 0        InsertionSort Array(), start&, finish&, order&END SELECTEND SUBSUB EfficientMerge (right() AS DOUBLE, start&, finish&, order&)half& = start& + (finish& - start&) \ 2REDIM left(start& TO half&) AS DOUBLE '* hold the first half of the array in slave()FOR LoadLeft& = start& TO half&    left(LoadLeft&) = right(LoadLeft&)NEXTSELECT CASE order&    CASE 1        i& = start&        j& = half& + 1        insert& = start&        DO            IF i& > half& THEN '* left() exhausted                IF j& > finish& THEN '* right() exhausted                    EXIT DO                ELSE                    '* stuff remains in right to be inserted, so flush right()                    WHILE j& <= finish&                        right(insert&) = right(j&)                        j& = j& + 1                        insert& = insert& + 1                    WEND                    EXIT DO                    '* and exit                END IF            ELSE                IF j& > finish& THEN                    WHILE i& < LoadLeft&                        right(insert&) = left(i&)                        i& = i& + 1                        insert& = insert& + 1                    WEND                    EXIT DO                ELSE                    IF right(j&) < left(i&) THEN                        right(insert&) = right(j&)                        j& = j& + 1                    ELSE                        right(insert&) = left(i&)                        i& = i& + 1                    END IF                    insert& = insert& + 1                END IF            END IF        LOOP    CASE ELSE        i& = half&        j& = finish&        insert& = finish&        DO            IF i& < start& THEN '* left() exhausted                IF j& < half& + 1 THEN '* right() exhausted                    EXIT DO                ELSE                    '* stuff remains in right to be inserted, so flush right()                    WHILE j& >= half&                        right(insert&) = right(j&)                        j& = j& - 1                        insert& = insert& - 1                    WEND                    EXIT DO                    '* and exit                END IF            ELSE                IF j& < half& + 1 THEN                    WHILE i& >= start&                        right(insert&) = left(i&)                        i& = i& - 1                        insert& = insert& - 1                    WEND                    EXIT DO                ELSE                    IF left(i&) > right(j&) THEN                        right(insert&) = right(j&)                        j& = j& - 1                    ELSE                        right(insert&) = left(i&)                        i& = i& - 1                    END IF                    insert& = insert& - 1                END IF            END IF        LOOPEND SELECTERASE leftEND SUBSUB InsertionSort (Array() AS DOUBLE, start&, finish&, order&)SELECT CASE order&    CASE 1        FOR i& = start& + 1 TO finish&            FOR j& = i& TO start& + 1 STEP -1                IF Array(j& - 1) > Array(j&) THEN                    SWAP Array(j&), Array(j& - 1)                ELSE                    EXIT FOR                END IF            NEXT        NEXT    CASE ELSE        FOR i& = start& + 1 TO finish&            FOR j& = i& TO start& + 1 STEP -1                IF Array(j& - 1) < Array(j&) THEN                    SWAP Array(j&), Array(j& - 1)                ELSE                    EXIT FOR                END IF            NEXT        NEXTEND SELECTEND SUB`
« Last Edit: October 07, 2017, 08:48:12 pm by codeguy »

#### SMcNeill

• Moderator
• Hero Member
• Posts: 6236
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #7 on: August 06, 2017, 04:33:32 am »
Is your beloved O(NLogN)/mergesort blowing up on you because of memory? Have I got a solution for you. It's called EfficientMerge, well at least in the code update I'll be posting shortly. It requires 1/2 the memory for merging the standard algorithm uses. At vetly large N, this can mean the difference between success and failure. Sure there are sorts that require no or little extra memory, but they lack stability. So to aid MergeSort to 33% more reliability and range. I'll submit the revised library code when I'm on my laptop. Not only does it save time, it also saves memory. And time? It saves 26&% at 33 million plus. Still, FlashSort remains the reigning champ, beating QuickSort by a margin of 18% in this same range. Because speed matters for huge datasets.

Also, you might want to include an example of a Binary Inclusion Sort, which would be used to insert data into an already sorted array.  (When your dataset is already sorted, it's the best way to add new data.)

Say for example I have the following _BYTE values sorted:

0,10,20,30,40,50,60,70,80,90,100

And I want to add the value 55 to the list...

Since it's sorted, we start at the middle
lowend = element 0: highend = element 11: middle = (0 + 11) / 2 = 5.5

element 5 = 50  (0, 10, 20, 30, 40, 50 is the 5th element, counting starting at 0)

Since 55 > 50, we change the lowend to 50 and repeat...

Continue until we highend = lowend + 1, then we know where to put it.

In this case we use 2^n as a max number of comparisons to find where to put the value.

Then with _MEM we just move everything to the right of that point one step over, and then insert the new value.

I think I have a demo of doing this somewhere on the forums.  I'll see if I can dig it up for you later.  If not, I can write a new version sometime easily enough.

max 2^n comparisons, 1 memory move, 1 memory insert...  It's the fastest way to go when adding new data into an already existing dataset, of any noticeable size.
http://bit.ly/Color32BI -- A set of color CONST for use in 32 bit mode, as a BI library.

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #8 on: August 06, 2017, 06:28:46 am »
InsertionSortBinary() already included. roughly 25% faster than standard InsertionSort. Also changed Mergeort to use EfficientMerge for a nice speedup and less memory overhead. And included a test harness as a separate program to execute and verify sort algorithms. Latest inclusion is CycleSort. You'll see I've included the start of a FlashString() to extend FlashSort() to string types.

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #9 on: August 09, 2017, 02:26:20 pm »
Code: [Select]
`'******************************************'* 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.'******************************************`
Code: [Select]
`SUB HashListSort (array() AS DOUBLE, start&, finish&, order&)GetMinMaxArray array(), start&, finish&, ptrmin&, ptrmax&IF ptrmin& = ptrmax& THEN EXIT SUBdelta# = array(ptrmax&) - array(ptrmin&)Probe& = primeNumber&(1.25# * (finish& - start&)) - 1REDIM HashTable(0 TO Probe&) AS DOUBLEREDIM Count(0 TO Probe&) AS LONGFOR s& = start& TO finish&    pnum# = array(s&) - array(ptrmin&)    f& = INT(Probe& * pnum# / delta#)    DO        IF f& > Probe& THEN            f& = f& - Probe&        END IF        IF f& < 0 THEN            f& = f& + Probe&        END IF        IF HashTable(f&) = array(s&) THEN            Count(f&) = Count(f&) + 1            EXIT DO        ELSE            IF Count(f&) = 0 THEN                HashTable(f&) = array(s&)                Count(f&) = 1                EXIT DO            END IF        END IF        f& = f& + 1    LOOPNEXTinserted& = start&IF order& = 1 THEN    FOR s& = 0 TO Probe&        WHILE Count(s&) > 0            array(inserted&) = HashTable(s&)            inserted& = inserted& + 1            Count(s&) = Count(s&) - 1        WEND    NEXTELSE    FOR s& = Probe& TO 0 STEP -1        WHILE Count(s&) > 0            array(inserted&) = HashTable(s&)            inserted& = inserted& + 1            Count(s&) = Count(s&) - 1        WEND    NEXTEND IFERASE Count, HashTableInsertionSort array(), start&, finish&, order&END SUB`

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #10 on: August 10, 2017, 02:08:39 am »
'********************
'* Some declare radix sort as faster than QuickSort. I have yet to see evidence of this in bitwise mode.
'* works with non-integer types too. for faster performance, change the Radix. In this case it is 2. This is bitwise.
'* ct&() needs to accomodate the numeric range of bits. the radix for one byte would be calculated by NTmpN AND 255
'* and requires ct&(-128 to 127). Unfortuately the final InsertionSort is required. Fortunately, it runs in nearly
'* O(n) time as the array is almost perfectly sorted prior.
'********************

Code: [Select]
`SUB RadixSort (a() AS DOUBLE, start&, finish&, order&)GetMinMaxArray a(), start&, finish&, minptr&, maxptr&IF minptr& = maxptr& THEN EXIT SUB '* no div0 bombsdelta# = a(maxptr&) - a(minptr&)DIM pow2 AS _UNSIGNED _INTEGER64DIM NtmpN AS _UNSIGNED _INTEGER64REDIM ct&(-1 TO 1)REDIM Radixarray(-1 TO 1, finish& - start&) AS DOUBLEREDIM Int64MaxShift AS _INTEGER64Int64MaxShift = 2 ^ 64pow2 = 1FOR bits& = 0 TO 63    FOR i& = start& TO finish&        NtmpN = Int64MaxShift * (a(i&) - a(minptr&)) / (delta#)        IF NtmpN AND pow2 THEN            tmpradix% = 1        ELSE            tmpradix% = 0        END IF        Radixarray(tmpradix%, ct&(tmpradix%)) = a(i&)        ct&(tmpradix%) = ct&(tmpradix%) + 1    NEXT    c& = start&    FOR i& = 1 TO -1 STEP -1        FOR j& = 0 TO ct&(i&) - 1            a(c&) = Radixarray(i&, j&)            c& = c& + 1        NEXT        ct&(i&) = 0    NEXT    pow2 = pow2 * 2NEXTERASE Radixarray, ct&IF order& = 1 THEN    StableInvert a(), start&, finish&, 1END IFInsertionSort a(), start&, finish&, order&END SUB`
finally gve up trying to sort ascending using RadixSort, so ther's an array inversion called ascending order.
« Last Edit: August 10, 2017, 11:02:13 pm by codeguy »

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #11 on: September 02, 2017, 10:04:12 pm »
Code: [Select]
`'* Possible _MEM sorter'* this is where you'd copy _mem to a\$ or whateverElementLength& = 4a\$ = ""FOR i = 1 TO 1024    a\$ = a\$ + CHR\$(ASC("0") + INT(RND * (9)))NEXTQuickSortIterative a\$, 0, LEN(a\$) \ ElementLength& - 1, ElementLength&, 1FOR s& = 0 TO LEN(a\$) \ ElementLength& - 1    PRINT MID\$(a\$, GetOffset&(s&, ElementLength&), ElementLength&); " ";NEXTSUB QuickSortIterative (a\$, Start&, Finish&, elementLength&, order&)DIM compare AS DOUBLEMinStack& = LOG(Finish& - Start& + 1) \ LOG(2) + 1DIM LStack&(MinStack&, 1)StackPtr& = 0LStack&(StackPtr&, 0) = Start&LStack&(StackPtr&, 1) = Finish&DO    Low& = LStack&(StackPtr&, 0)    Hi& = LStack&(StackPtr&, 1)    DO        i& = Low&        j& = Hi&        Mid& = Low& + (Hi& - Low& + 1) \ 2        compare = GetElement&(a\$, Mid&, elementLength&)        SELECT CASE order&            CASE 1                DO                    DO WHILE GetElement&(a\$, i&, elementLength&) < compare                        i& = i& + 1                    LOOP                    DO WHILE GetElement&(a\$, j&, elementLength&) > compare                        j& = j& - 1                    LOOP                    IF i& <= j& THEN                        'SWAP GetElement&(a\$,i&,elementlength&), GetElement&(a\$,j&,elementlength&)                        io& = GetOffset&(i&, elementLength&)                        jo& = GetOffset&(j&, elementLength&)                        b\$ = MID\$(a\$, io&, elementLength&)                        c\$ = MID\$(a\$, jo&, elementLength&)                        MID\$(a\$, io&, elementLength&) = c\$                        MID\$(a\$, jo&, elementLength&) = b\$                        i& = i& + 1                        j& = j& - 1                    END IF                LOOP UNTIL i& > j&            CASE ELSE                DO                    DO WHILE GetElement&(a\$, i&, elementLength&) > compare                        i& = i& + 1                    LOOP                    DO WHILE GetElement&(a\$, j&, elementLength&) < compare                        j& = j& - 1                    LOOP                    IF i& <= j& THEN                        'SWAP GetElement&(i&), GetElement&(j&)                        io& = GetOffset&(i&, elementLength&)                        jo& = GetOffset&(j&, elementLength&)                        b\$ = MID\$(a\$, io&, elementLength&)                        c\$ = MID\$(a\$, jo&, elementLength&)                        MID\$(a\$, io&, elementLength&) = c\$                        MID\$(a\$, jo&, elementLength&) = b\$                        i& = i& + 1                        j& = j& - 1                    END IF                LOOP UNTIL i& > j&        END SELECT        IF j& - Low& < Hi& - i& THEN            IF i& < Hi& THEN                LStack&(StackPtr&, 0) = i&                LStack&(StackPtr&, 1) = Hi&                StackPtr& = StackPtr& + 1            END IF            Hi& = j&        ELSE            IF Low& < j& THEN                LStack&(StackPtr&, 0) = Low&                LStack&(StackPtr&, 1) = j&                StackPtr& = StackPtr& + 1            END IF            Low& = i&        END IF    LOOP WHILE Low& < Hi&    StackPtr& = StackPtr& - 1LOOP UNTIL StackPtr& < 0END SUBFUNCTION GetOffset& (i&, numbytes&)GetOffset& = i& * numbytes& + 1'* for _mem, + 1 is changed to nothingEND FUNCTIONFUNCTION GetElement& (a\$, i&, NumBytesElement&)GetElement& = VAL(MID\$(a\$, GetOffset&(i&, NumBytesElement&), NumBytesElement&))END FUNCTION`

#### RhoSigma

• Sr. Member
• Posts: 364
• Out of Time !!
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #12 on: September 03, 2017, 05:00:06 am »
Maybe another alternative to look at:
http://alienryderflex.com/quicksort/

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #13 on: September 03, 2017, 05:18:16 pm »
The iterative version using a software stack is thus far the ONLY I can depend on for 100% error-free performance besides the Yaroslavsky dual-pivot version. These are the versions I'd recommend. BTW, stacks in software are faster than hardware stacks. At least versus current tech.

BTW, binary insertion is roughly 25% faster than InsertionSort. Already been there, done that.
« Last Edit: September 03, 2017, 05:35:11 pm by codeguy »

#### codeguy

• Hero Member
• Posts: 4022
• what the h3ll did i name that code?
##### Re: Sorting Methods. The Best and not necessarily fastest algorithms.
« Reply #14 on: October 07, 2017, 08:37:30 pm »
Do you need to sort numbers with blinding speed? Here you go. Tested and verified using a sequence check after during development.
Code: [Select]
`TYPE MinMaxRec    min AS LONG    max AS LONGEND TYPENTest& = 99999999REDIM Array(0 TO NTest&) AS DOUBLEFOR q& = 0 TO NTest&    Array(q&) = INT(RND * ((2 ^ 31) * 2 - 1))NEXTSortOrder& = 1s! = TIMER(.001)HashListSort Array(), 0, NTest&, SortOrder&f! = TIMER(.001)'* sequence check for ascending or descending order (the 1 used in the call to HashListSort)seqstart! = TIMER(.001)IF SortOrder& = 1 THEN    h& = LBOUND(array)    FOR c& = 0 TO NTest&        IF Array(s&) < Array(h&) THEN            STOP        ELSEIF Array(s&) > Array(h&) THEN            h& = s&        END IF    NEXTELSE    h& = LBOUND(array)    FOR c& = 0 TO NTest&        IF Array(s&) > Array(h&) THEN            STOP        ELSEIF Array(s&) < Array(h&) THEN            h& = s&        END IF    NEXTEND IFseqFinish! = TIMER(.001)'* if there's a sequence error, this will never display. This takes roughly as long as the sort itself.'* for N=100,000,000, the sequence check actually takes LONGER than the sort itself.IF f! - s! < seqFinish! - seqstart! THEN    PRINT f! - s!; " time to sort was faster."; (f! - s!) / (seqFinish! - seqstart!)    PRINT seqFinish! - seqstart!; " time to sequence check"ELSE    PRINT f! - s!; " time to sequence check was faster or same."; (f! - s!) / (seqFinish! - seqstart!)    PRINT seqFinish! - seqstart!; " time to sequence check"END IF`
Code: [Select]
`'******************************************'* 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.'******************************************[code]SUB HashListSort (array() AS DOUBLE, start&, finish&, order&)    DIM Mrec AS MinMaxRec    GetMinMax array(), start&, finish&, Mrec    IF array(minmax.min) = array(minmax.max) THEN EXIT SUB    delta# = array(minmax.max) - array(minmax.max)    Probe& = pRIMEnUMBER&(2 * INT(1.25# * (finish& - start&) / 2) - 1, -1)    REDIM HashTable(0 TO Probe&) AS DOUBLE    REDIM Count(0 TO Probe&) AS LONG    FOR s& = start& TO finish&        pnum# = array(s&) - array(ptrmin&)        f& = INT(Probe& * pnum# / delta#)        DO            IF f& > Probe& THEN                f& = f& - Probe&            END IF            IF f& < 0 THEN                f& = f& + Probe&            END IF            IF HashTable(f&) = array(s&) THEN                Count(f&) = Count(f&) + 1                EXIT DO            ELSE                IF Count(f&) = 0 THEN                    HashTable(f&) = array(s&)                    Count(f&) = 1                    EXIT DO                END IF            END IF            f& = f& + 1        LOOP    NEXT    inserted& = start&    IF order& = 1 THEN        FOR s& = 0 TO Probe&            WHILE Count(s&) > 0                array(inserted&) = HashTable(s&)                inserted& = inserted& + 1                Count(s&) = Count(s&) - 1            WEND        NEXT    ELSE        FOR s& = Probe& TO 0 STEP -1            WHILE Count(s&) > 0                array(inserted&) = HashTable(s&)                inserted& = inserted& + 1                Count(s&) = Count(s&) - 1            WEND        NEXT    END IF    ERASE Count, HashTable    InsertionSort array(), start&, finish&, order&END SUB'* This is the original version of the faster min-max vector searchSUB GetMinMax (array() AS DOUBLE, Start&, finish&, minmax AS MinMaxRec)    n& = finish& - Start&    IF (n& MOD 2) THEN        minmax.min = Start&        minmax.max = Start&        i& = Start& + 1    ELSE        IF array(Start&) > array(finish&) THEN            minmax.max = Start&            minmax.min = finish&        ELSE            minmax.min = finish&            minmax.max = Start&        END IF        i& = Start& + 2    END IF '    WHILE (i& < n&)        IF array(i&) > array(i& + 1) THEN            IF array(i&) > array(minmax.max) THEN                minmax.max = i&            END IF            IF array(i& + 1) < array(minmax.min) THEN                minmax.min = i& + 1            END IF        ELSE            IF array(i& + 1) > array(minmax.max) THEN                minmax.max = i& + 1            END IF            IF array(i&) < array(minmax.min) THEN                minmax.min = i&            END IF        END IF        i& = i& + 2    WENDEND SUBFUNCTION pRIMEnUMBER& (finish&, direction%)    N& = finish& - START&    IF (N& MOD 2) <> 0 THEN        N& = N& + (2 * direction%)    END IF    sqrootn& = 2 * (SQR(N&) \ 2) + 1    div& = 3    DO        IF div& > sqrootn& THEN            EXIT DO        ELSE            IF (N& MOD div&) THEN                div& = div& + 2            ELSE                N& = N& + (2 * direction%)                sqrootn& = 2 * (SQR(N&) \ 2) + 1                div& = 3            END IF        END IF    LOOP    pRIMEnUMBER& = N&END FUNCTION'********************'* 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.'********************SUB InsertionSort (Array() AS DOUBLE, start&, finish&, order&)    SELECT CASE order&        CASE 1            FOR i& = start& + 1 TO finish&                FOR j& = i& TO start& + 1 STEP -1                    IF Array(j& - 1) > Array(j&) THEN                        SWAP Array(j&), Array(j& - 1)                    ELSE                        EXIT FOR                    END IF                NEXT            NEXT        CASE ELSE            FOR i& = start& + 1 TO finish&                FOR j& = i& TO start& + 1 STEP -1                    IF Array(j& - 1) < Array(j&) THEN                        SWAP Array(j&), Array(j& - 1)                    ELSE                        EXIT FOR                    END IF                NEXT            NEXT    END SELECTEND SUB`
FlashSort is no longer king of the hill. I make no apologies to KD Neubert. I dethroned FlashSort. Handily. Nearly 28 times as fast for 100 million elements. 156s versus 5.625s (HashListSort).
« Last Edit: March 04, 2018, 06:25:14 am by codeguy »