Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations bkrike on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Sorting Arrays 1

Status
Not open for further replies.

segmentationfault

Programmer
Jun 21, 2001
160
US
The question came up recently about sorting arrays and I provided a simple bubble sort that is suitable for arrays up to about 500 elements in size. Noticing that VB's implementation of arrays is woefully lacking, and also that I have a number of functions that make arrays more useful, here is an algorithm that will sort 100,000 numbers in about 6 seconds on a PII 450MHz processor. The trade off for this speed is memory - this is a recursive algorithm that makes many copies of the data.

If feedback from this is positive and there is an issue with the memory consumption, it is possible to achieve this sort with only one copy of the data, however that involves raising the scope to a level that each of these functions can see. I try to avoid having large arrays so lightly guarded, so I think it isn't a big issue. Disclaimers out of the way, enjoy:

Code:
Function MergeSort(data())
    ' This delegates the task of sorting
    ' two half sized arrays to copies of
    ' itself, and finally to the
    ' BubbleSort when the array is
    ' sufficiently small.

    Dim sorted

    ' Note that this comparison is the
    ' tradeoff between performance and
    ' memory.  Higher numbers will save
    ' memory at the cost of speed.
    If UBound(data) < 20 Then
        sorted = BubbleSort(data)
    Else
        Dim lhs As Long
        Dim rhs As Long
        lhs = Int(UBound(data) / 2)
        rhs = UBound(data) - lhs
        ReDim lhsdata(lhs)
        ReDim rhsdata(rhs)
        Dim i As Long
        For i = 0 To lhs - 1
            lhsdata(i) = data(i)
        Next i
        For i = 0 To rhs - 1
            rhsdata(i) = data(lhs + i)
        Next i
        ReDim lhsSorted(lhs)
        ReDim rhsSorted(rhs)
        lhsSorted = MergeSort(lhsdata)
        rhsSorted = MergeSort(rhsdata)
        sorted = Merge(lhsSorted, rhsSorted)
    End If
    MergeSort = sorted
End Function

Function Merge(data1(), Data2())
    ' This assembles two sorted array into
    ' a single sorted array
    Dim i As Long
    Dim j As Long
    Dim k As Long
    i = 0
    j = 0
    k = 0
    Dim SortedData()
    ReDim SortedData(UBound(data1) + UBound(Data2))
    While k < UBound(SortedData)
        If i < UBound(data1) And j < UBound(Data2) Then
            If data1(i) < Data2(j) Then
                SortedData(k) = data1(i)
                i = i + 1
            Else
                SortedData(k) = Data2(j)
                j = j + 1
            End If
        ElseIf i < UBound(data1) Then
            SortedData(k) = data1(i)
            i = i + 1
        ElseIf j < UBound(Data2) Then
            SortedData(k) = Data2(j)
            j = j + 1
        End If
        k = k + 1
    Wend
    Merge = SortedData
End Function

Function BubbleSort(data())
    ' This does the actual sorting but is
    ' only executed on small arrays
    Dim Temp As Long
    Dim i As Long
    Dim j As Long
    For i = 1 To UBound(data) - 1
        If data(i - 1) > data(i) Then
            j = i
            While j > 0
                If data(j - 1) > data(j) Then
                    Temp = data(j)
                    data(j) = data(j - 1)
                    data(j - 1) = Temp
                Else
                    j = 0
                End If
                j = j - 1
            Wend
        End If
    Next i

    BubbleSort = data
End Function

If anybody has refinements, I'd be happy to see them.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top