Bucketsort

From Rosetta Code

QB64

<lang B64> REDIM a(0 to 1048575) FOR FillArray& LBOUND(a) to UBOUND(a)

   a(Fillearray&) = RND

NEXT DoRecurse% = -1 DemoOrder& = 1 ' -1 = descending, 1 = desecending 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
                   '* Withoit this, 28s+
                   BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&, 0
               ELSE
                   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 </lang>