Bucketsort: Difference between revisions

From Rosetta Code
Content added Content deleted
(Created page with "=={{header|QB64}}== <lang B64>REDIM a(0 TO 9999) AS STRING FOR z& = LBOUND(a) TO UBOUND(a) a(z&) = CHR$((33 + RND * (256 - 33)) AND 255) NEXT BucketSort a$() FOR u& = LBOU...")
 
Line 1: Line 1:
=={{header|QB64}}==
=={{header|QB64}}==
<lang B64>REDIM a(0 TO 9999) AS STRING
<lang B64>
REDIM a(0 to 1048575)
FOR z& = LBOUND(a) TO UBOUND(a)
FOR FillArray& LBOUND(a) to UBOUND(a)
a(z&) = CHR$((33 + RND * (256 - 33)) AND 255)
a(Fillearray&) = RND
NEXT
NEXT
DoRecurse% = -1
BucketSort a$()
DemoOrder& = 1 ' -1 = descending, 1 = desecending
FOR u& = LBOUND(a$) TO UBOUND(a$)
BucketSort a(), LBOUND(a), UBOUND(a), DemoOrder&, DoRecurse% '* without the recursive initial call, executiom time is FAR slower.
PRINT a$(u&);
NEXT
SUB BucketSort (a() AS STRING)
REDIM Bucketcount(0 TO 255) AS LONG
MinAscii% = 255
MaxAscii% = 0
Biggest% = LBOUND(BucketCount)
FOR scan& = LBOUND(a) TO UBOUND(a)
IF a(scan&) > "" THEN
ascii% = ASC(a(scan&))
IF ascii% < MinAscii% THEN
MinAscii% = ascii%
END IF
IF ascii% > MaxAscii% THEN
MaxAscii% = ascii%
END IF
IF Bucketcount(ascii%) > Bucketcount(Biggest%) THEN
Biggest% = ascii%
END IF
Bucketcount(ascii%) = Bucketcount(ascii%) + 1
END IF
NEXT
PRINT MinAscii%, MaxAscii%
REDIM Buckets(MinAscii% TO MaxAscii%, 0 TO Bucketcount(Biggest%)) AS STRING
REDIM Bucketcount(MinAscii% TO MaxAscii%) AS LONG
FOR scan& = LBOUND(a) TO UBOUND(a)
IF a(scan&) > "" THEN
nthbucket% = ASC(a(scan&))
PRINT nthbucket%
Buckets(nthbucket%, Bucketcount(nthbucket%)) = a(scan&)
Bucketcount(nthbucket%) = Bucketcount(nthbucket%) + 1
END IF
NEXT
xsum& = LBOUND(a)
FOR i% = MinAscii% TO MaxAscii%
EMerge a(), 0, Bucketcount(i%) - 1
FOR j% = 0 TO Bucketcount(i%) - 1
a(xsum&) = Buckets(i%, j%)
xsum& = xsum& + 1
NEXT
NEXT
ERASE Buckets
ERASE Bucketcount
END SUB

SUB EMerge (Array() AS STRING, start&, finish&)
IF finish& - start& = 1 THEN
IF Array(start&) > Array(finish&) THEN
SWAP Array(start&), Array(finish&)
END IF
ELSE
IF finish& - start& > 1 THEN
m& = start& + (finish& - start& + 1) \ 2
EMerge Array(), start&, m&
EMerge Array(), m& + 1, finish&
EfficientMerge Array(), start&, m&, finish&
END IF
END IF
END SUB

SUB EfficientMerge (Array() AS STRING, start&, m&, finish&)
DIM b(start& TO m&) AS STRING
i& = start&
j& = m& + 1
' // copy first half of array a to auxiliary array b%()
DO
IF i& > m& THEN
EXIT DO
ELSE
b(i&) = Array(i&)
j& = j& + 1
i& = i& + 1
END IF
LOOP
i& = start&
j& = m& + 1
k& = start&
' // copy back next-greatest element at each time


SUB BucketSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&, recurse%)
DO
DIM BS_Local_NBuckets AS INTEGER
IF j& > finish& THEN
DIM BS_Local_ArrayRange AS DOUBLE
EXIT DO
DIM BS_Local_N AS LONG
ELSE
DIM BS_Local_S AS LONG
IF k& < j& THEN
DIM BS_Local_Z AS LONG
IF b(i&) <= Array(j&) THEN
DIM BS_Local_Remainder AS INTEGER
Array(k&) = b(i&)
DIM BS_Local_Index AS INTEGER
i& = i& + 1
DIM BS_Local_Last_Insert_Index AS LONG
ELSE
DIM BS_Local_Current_Insert_Index AS LONG
Array(k&) = Array(j&)
DIM BS_Local_BucketIndex AS INTEGER
j& = j& + 1
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
END IF
k& = k& + 1
NEXT
ERASE BS_Buckets_Array, BS_Count_Array
ELSE
EXIT DO
END IF
END IF
END IF
LOOP
' // copy back remaining elements of first half (if any)
WHILE (k& < j&)
Array(k&) = b(i&)
k& = k& + 1
i& = i& + 1
WEND
ERASE b
END SUB
END SUB
</lang>
</lang>

Revision as of 15:04, 15 March 2018

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>

Retrieved from "https://rosettacode.org/wiki/Bucketsort?oldid=279318"