Bucketsort: Difference between revisions

Content added Content deleted
Line 1: Line 1:
=={{header|QB64}}==
=={{header|QB64}}==
<lang B64>
<lang B64>
TYPE MINMaxRec
⚫
REDIM a(0 to 1048575) AS DOUBLE
min AS LONG
⚫
FOR FillArray& = LBOUND(a) to UBOUND(a)
max AS LONG
END TYPE

⚫
REDIM a(0 TO 1048575) AS DOUBLE
⚫
FOR FillArray& = LBOUND(a) TO UBOUND(a)
a(Fillearray&) = RND
a(Fillearray&) = RND
NEXT
NEXT
Line 10: Line 15:


SUB BucketSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&, recurse%)
SUB BucketSort (Array() AS DOUBLE, start AS LONG, finish AS LONG, order&, recurse%)
DIM BS_Local_NBuckets AS INTEGER
DIM BS_Local_NBuckets AS INTEGER
DIM BS_Local_ArrayRange AS DOUBLE
DIM BS_Local_ArrayRange AS DOUBLE
DIM BS_Local_N AS LONG
DIM BS_Local_N AS LONG
DIM BS_Local_S AS LONG
DIM BS_Local_S AS LONG
DIM BS_Local_Z AS LONG
DIM BS_Local_Z AS LONG
DIM BS_Local_Remainder AS INTEGER
DIM BS_Local_Remainder AS INTEGER
DIM BS_Local_Index AS INTEGER
DIM BS_Local_Index AS INTEGER
DIM BS_Local_Last_Insert_Index AS LONG
DIM BS_Local_Last_Insert_Index AS LONG
DIM BS_Local_Current_Insert_Index AS LONG
DIM BS_Local_Current_Insert_Index AS LONG
DIM BS_Local_BucketIndex AS INTEGER
DIM BS_Local_BucketIndex AS INTEGER
REDIM BSMMrec AS MinMaxRec
REDIM BSMMrec AS MINMaxRec
GetMinMaxArray Array(), start, finish, BSMMrec
GetMinMaxArray Array(), start, finish, BSMMrec
BS_Local_ArrayRange = Array(BSMMrec.max) - Array(BSMMrec.min)
BS_Local_ArrayRange = Array(BSMMrec.max) - Array(BSMMrec.min)
IF BS_Local_ArrayRange > 0 THEN
IF BS_Local_ArrayRange > 0 THEN
BS_Local_NBuckets = 2 * INT(LOG(finish - start + 1) / LOG(2)) + 1
BS_Local_NBuckets = 2 * INT(LOG(finish - start + 1) / LOG(2)) + 1
BS_Local_N = (finish - start)
BS_Local_N = (finish - start)
BS_Local_Remainder = BS_Local_N MOD BS_Local_NBuckets
BS_Local_Remainder = BS_Local_N MOD BS_Local_NBuckets
BS_Local_NBuckets = BS_Local_NBuckets - 1
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_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
REDIM BS_Count_Array(0 TO BS_Local_NBuckets) AS LONG
FOR BS_Local_S = start TO finish
FOR BS_Local_S = start TO finish
BS_Local_BucketIndex = BS_Local_NBuckets * ((Array(BS_Local_S) - Array(BSMMrec.min)) / BS_Local_ArrayRange)
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_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
BS_Count_Array(BS_Local_BucketIndex) = BS_Count_Array(BS_Local_BucketIndex) + 1
NEXT
NEXT
BS_Local_Last_Insert_Index = start
BS_Local_Last_Insert_Index = start
BS_Local_Current_Insert_Index = start
BS_Local_Current_Insert_Index = start
FOR BS_Local_S = 0 TO BS_Local_NBuckets
FOR BS_Local_S = 0 TO BS_Local_NBuckets
IF BS_Count_Array(BS_Local_S) > 0 THEN
IF BS_Count_Array(BS_Local_S) > 0 THEN
BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
BS_Local_Last_Insert_Index = BS_Local_Current_Insert_Index
FOR BS_Local_Z = 0 TO BS_Count_Array(BS_Local_S) - 1
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)
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
BS_Local_Current_Insert_Index = BS_Local_Current_Insert_Index + 1
NEXT
NEXT
IF recurse% THEN
IF recurse% THEN
'* Without this, Bucketort() will be much slower
'* Without this, Bucketort() will be much slower
BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&, 0
BucketSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&, 0
ELSE
ELSE
InsertionSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&
InsertionSort Array(), BS_Local_Last_Insert_Index, BS_Local_Current_Insert_Index - 1, order&
⚫
END IF
END IF
END IF
NEXT
END IF
NEXT
ERASE BS_Buckets_Array, BS_Count_Array
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
END IF
GetGetMinMaxArray_minmaxArray_i = GetGetMinMaxArray_minmaxArray_i + 2
WEND
END SUB
END SUB


SUB InsertionSort (array() AS DOUBLE, start AS LONG, finish AS LONG, order&)
SUB InsertionSort (array() AS DOUBLE, start AS LONG, finish AS LONG, order&)
DIM InSort_L_ArrayTemp AS DOUBLE
DIM InSort_L_ArrayTemp AS DOUBLE
DIM InSort_L_i AS LONG
DIM InSort_L_i AS LONG
DIM InSort_L_j AS LONG
DIM InSort_L_j AS LONG
SELECT CASE order&
SELECT CASE order&
CASE 1
CASE 1
FOR InSort_L_i = start + 1 TO finish
FOR InSort_L_i = start + 1 TO finish
InSort_L_ArrayTemp = array(InSort_L_i)
InSort_L_ArrayTemp = array(InSort_L_i)
InSort_L_j = InSort_L_i - 1
InSort_L_j = InSort_L_i - 1
DO UNTIL InSort_L_j < start
DO UNTIL InSort_L_j < start
IF (InSort_L_ArrayTemp < array(InSort_L_j)) THEN
IF (InSort_L_ArrayTemp < array(InSort_L_j)) THEN
array(InSort_L_j + 1) = array(InSort_L_j)
array(InSort_L_j + 1) = array(InSort_L_j)
InSort_L_j = InSort_L_j - 1
InSort_L_j = InSort_L_j - 1
ELSE
ELSE
EXIT DO
EXIT DO
END IF
END IF
LOOP
LOOP
array(InSort_L_j + 1) = InSort_L_ArrayTemp
array(InSort_L_j + 1) = InSort_L_ArrayTemp
NEXT
NEXT
CASE ELSE
CASE ELSE
FOR InSort_L_i = start + 1 TO finish
FOR InSort_L_i = start + 1 TO finish
InSort_L_ArrayTemp = array(InSort_L_i)
InSort_L_ArrayTemp = array(InSort_L_i)
InSort_L_j = InSort_L_i - 1
InSort_L_j = InSort_L_i - 1
DO UNTIL InSort_L_j < start
DO UNTIL InSort_L_j < start
IF (InSort_L_ArrayTemp > array(InSort_L_j)) THEN
IF (InSort_L_ArrayTemp > array(InSort_L_j)) THEN
array(InSort_L_j + 1) = array(InSort_L_j)
array(InSort_L_j + 1) = array(InSort_L_j)
InSort_L_j = InSort_L_j - 1
InSort_L_j = InSort_L_j - 1
ELSE
ELSE
EXIT DO
EXIT DO
END IF
END IF
LOOP
LOOP
array(InSort_L_j + 1) = InSort_L_ArrayTemp
array(InSort_L_j + 1) = InSort_L_ArrayTemp
NEXT
NEXT
END SELECT
END SELECT
END SUB
END SUB
</lang>
</lang>
Retrieved from "https://rosettacode.org/wiki/Bucketsort"