Comparison QB64 compiled with gcc optimizations and without

[Coolman]

Bucketsort : I got this code from the site rosettacode.

3.4x seconds : program compiled with qb64 -Ofast
3.4x seconds : program compiled with original qb64

strangely, disappointing. almost no gain.

Code: (Select All)

'* 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
Print "start...": Print
start = Timer(.001)
BucketSort a(), LBound(a), UBound(a), DemoOrder&, DoRecurse% '* without the recursive initial call, executiom time is FAR slower.
Print Timer(.001) - start; "seconds"

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