VB6 Quick Sort, Binary Search & Knuth shuffle Algorithms

Visual Basic Topics
Post Reply
User avatar
Saman
Lieutenant Colonel
Lieutenant Colonel
Posts: 828
Joined: Fri Jul 31, 2009 10:32 pm
Location: Mount Lavinia

VB6 Quick Sort, Binary Search & Knuth shuffle Algorithms

Post by Saman » Sun Aug 19, 2018 10:04 am

Code: Select all

' Omit plngLeft & plngRight; they are used internally during recursion
Public Sub QuickSort(ByRef pvarArray As Variant, Optional ByVal plngLeft As Long, Optional ByVal plngRight As Long)
    Dim lngFirst As Long
    Dim lngLast As Long
    Dim varMid As Variant
    Dim varSwap As Variant
    
    If plngRight = 0 Then
        plngLeft = LBound(pvarArray)
        plngRight = UBound(pvarArray)
    End If
    lngFirst = plngLeft
    lngLast = plngRight
    varMid = pvarArray((plngLeft + plngRight) \ 2)
    Do
        Do While pvarArray(lngFirst) < varMid And lngFirst < plngRight
            lngFirst = lngFirst + 1
        Loop
        Do While varMid < pvarArray(lngLast) And lngLast > plngLeft
            lngLast = lngLast - 1
        Loop
        If lngFirst <= lngLast Then
            varSwap = pvarArray(lngFirst)
            pvarArray(lngFirst) = pvarArray(lngLast)
            pvarArray(lngLast) = varSwap
            lngFirst = lngFirst + 1
            lngLast = lngLast - 1
        End If
    Loop Until lngFirst > lngLast
    If plngLeft < lngLast Then QuickSort pvarArray, plngLeft, lngLast
    If lngFirst < plngRight Then QuickSort pvarArray, lngFirst, plngRight
End Sub

Code: Select all

' Simple binary search. Be sure array is sorted first.
' Returns index of first match, or -1 if no match found
Public Function BinarySearch(pvarArray As Variant, pvarFind As Variant) As Long
    Dim lngFirst As Long
    Dim lngMid As Long
    Dim lngLast As Long

    BinarySearch = -1
    lngMid = -1
    lngFirst = LBound(pvarArray)
    lngLast = UBound(pvarArray)
    Do While lngFirst <= lngLast
        lngMid = (lngFirst + lngLast) \ 2
        If pvarArray(lngMid) > pvarFind Then
            lngLast = lngMid - 1
        ElseIf pvarArray(lngMid) < pvarFind Then
            lngFirst = lngMid + 1
        Else
            Exit Do
        End If
    Loop
    ' Make sure this is the first match in array
    Do While lngMid > lngFirst
        If pvarArray(lngMid - 1) <> pvarFind Then Exit Do
        lngMid = lngMid - 1
    Loop
    ' Set return value if match was found
    If pvarArray(lngMid) = pvarFind Then BinarySearch = lngMid
End Function

Code: Select all

' Knuth shuffle (very fast)
Public Function ShuffleArray(pvarArray As Variant)
    Dim i As Long
    Dim iMin As Long
    Dim iMax As Long
    Dim lngReplace As Long
    Dim varSwap As Variant
    
    iMin = LBound(pvarArray)
    iMax = UBound(pvarArray)
    For i = iMax To iMin + 1 Step -1
        lngReplace = Int((i - iMin + 1) * Rnd + iMin)
        varSwap = pvarArray(i)
        pvarArray(i) = pvarArray(lngReplace)
        pvarArray(lngReplace) = varSwap
    Next
End Function
Post Reply

Return to “Visual Basic Programming”