Bucketsort

QB64

<lang B64> '* 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 </lang>