⚠️ Warning: This is a draft ⚠️

This means it might contain formatting issues, incorrect code, conceptual problems, or other severe issues.

If you want to help to improve and eventually enable this page, please fork RosettaGit's repository and open a merge request on GitHub.

QB64


'* Complexity Class: O(N^2)
TYPE MINMaxRec
    min AS LONG
    max AS LONG
END TYPE

REDIM a(0 TO 1048575) AS DOUBLE
FOR FillArray& = LBOUND(a) TO UBOUND(a)
    a(FillArray&) = RND
NEXT
DoRecurse% = -1
DemoOrder& = 1 '* -1 = descending
BucketSort a(), LBOUND(a), UBOUND(a), DemoOrder&, DoRecurse% '* without the recursive initial call, executiom time is FAR slower.

SUB BucketSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&, recurse%)
DIM BS_Local_NBuckets AS INTEGER
DIM BS_Local_ArrayRange AS DOUBLE
DIM BS_Local_N AS LONG
DIM BS_Local_S AS LONG
DIM BS_Local_Z AS LONG
DIM BS_Local_Remainder AS INTEGER
DIM BS_Local_Index AS INTEGER
DIM BS_Local_Last_Insert_Index AS LONG
DIM BS_Local_Current_Insert_Index AS LONG
DIM BS_Local_BucketIndex AS INTEGER
REDIM BSMMrec AS MINMaxRec
GetMinMaxArray Array(), start, finish, BSMMrec
BS_Local_ArrayRange = Array(BSMMrec.max) - Array(BSMMrec.min)
IF BS_Local_ArrayRange > 0 THEN
    BS_Local_NBuckets = 2 * INT(LOG(finish - start + 1) / LOG(2)) + 1
    BS_Local_N = (finish - start)
    BS_Local_Remainder = BS_Local_N MOD BS_Local_NBuckets
    BS_Local_NBuckets = BS_Local_NBuckets - 1
    REDIM BS_Buckets_Array(BS_Local_NBuckets, 0 TO (BS_Local_NBuckets * (1 + (BS_Local_N - BS_Local_Remainder) / BS_Local_NBuckets))) AS DOUBLE
    REDIM BS_Count_Array(0 TO BS_Local_NBuckets) AS LONG
    FOR BS_Local_S = start TO finish
        BS_Local_BucketIndex = BS_Local_NBuckets * ((Array(BS_Local_S) - Array(BSMMrec.min)) / BS_Local_ArrayRange)
        BS_Buckets_Array(BS_Local_BucketIndex, BS_Count_Array(BS_Local_BucketIndex)) = Array(BS_Local_S)
        BS_Count_Array(BS_Local_BucketIndex) = BS_Count_Array(BS_Local_BucketIndex) + 1
    NEXT
    BS_Local_Last_Insert_Index = start
    BS_Local_Current_Insert_Index = start
    FOR BS_Local_S = 0 TO BS_Local_NBuckets
        IF BS_Count_Array(BS_Local_S) > 0 THEN
            BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
            FOR BS_Local_Z = 0 TO BS_Count_Array(BS_Local_S) - 1
                Array(BS_Local_Current_Insert_Index) = BS_Buckets_Array(BS_Local_S, BS_Local_Z)
                BS_Local_Current_Insert_Index = BS_Local_Current_Insert_Index + 1
            NEXT
            IF recurse% THEN
                '* Without this, Bucketort() will be much slower
                BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&, 0
            ELSE
                '* using MergeSort will speed this significantly, however, this will be left as an exercise
                '* MergeSort will keep this sorting algorithm quite competitive.
                InsertionSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&
            END IF
        END IF
    NEXT
    ERASE BS_Buckets_Array, BS_Count_Array
END IF
END SUB

SUB GetMinMaxArray (array() AS DOUBLE, Start&, finish&, GetMinMaxArray_minmax AS MINMaxRec)
n& = finish& - Start&
t% = n& - 10000 * (n& \ 10000)
IF (t% MOD 2) THEN
    GetMinMaxArray_minmax.min = Start&
    GetMinMaxArray_minmax.max = Start&
    GetGetMinMaxArray_minmaxArray_i = Start& + 1
ELSE
    IF array(Start&) > array(finish&) THEN
        GetMinMaxArray_minmax.max = Start&
        GetMinMaxArray_minmax.min = finish&
    ELSE
        GetMinMaxArray_minmax.min = finish&
        GetMinMaxArray_minmax.max = Start&
    END IF
    GetGetMinMaxArray_minmaxArray_i = Start& + 2
END IF

WHILE GetGetMinMaxArray_minmaxArray_i < finish&
    IF array(GetGetMinMaxArray_minmaxArray_i) > array(GetGetMinMaxArray_minmaxArray_i + 1) THEN
        IF array(GetGetMinMaxArray_minmaxArray_i) > array(GetMinMaxArray_minmax.max) THEN
            GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i
        END IF
        IF array(GetGetMinMaxArray_minmaxArray_i + 1) < array(GetMinMaxArray_minmax.min) THEN
            GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i + 1
        END IF
    ELSE
        IF array(GetGetMinMaxArray_minmaxArray_i + 1) > array(GetMinMaxArray_minmax.max) THEN
            GetMinMaxArray_minmax.max = GetGetMinMaxArray_minmaxArray_i + 1
        END IF
        IF array(GetGetMinMaxArray_minmaxArray_i) < array(GetMinMaxArray_minmax.min) THEN
            GetMinMaxArray_minmax.min = GetGetMinMaxArray_minmaxArray_i
        END IF
    END IF
    GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
WEND
END SUB

SUB InsertionSort (array() AS DOUBLE, start AS LONG, finish AS LONG, order&)
DIM InSort_L_ArrayTemp AS DOUBLE
DIM InSort_L_i AS LONG
DIM InSort_L_j AS LONG
SELECT CASE order&
    CASE 1
        FOR InSort_L_i = start + 1 TO finish
            InSort_L_ArrayTemp = array(InSort_L_i)
            InSort_L_j = InSort_L_i - 1
            DO UNTIL InSort_L_j < start
                IF (InSort_L_ArrayTemp < array(InSort_L_j)) THEN
                    array(InSort_L_j + 1) = array(InSort_L_j)
                    InSort_L_j = InSort_L_j - 1
                ELSE
                    EXIT DO
                END IF
            LOOP
            array(InSort_L_j + 1) = InSort_L_ArrayTemp
        NEXT
    CASE ELSE
        FOR InSort_L_i = start + 1 TO finish
            InSort_L_ArrayTemp = array(InSort_L_i)
            InSort_L_j = InSort_L_i - 1
            DO UNTIL InSort_L_j < start
                IF (InSort_L_ArrayTemp > array(InSort_L_j)) THEN
                    array(InSort_L_j + 1) = array(InSort_L_j)
                    InSort_L_j = InSort_L_j - 1
                ELSE
                    EXIT DO
                END IF
            LOOP
            array(InSort_L_j + 1) = InSort_L_ArrayTemp
        NEXT
END SELECT
END SUB