-
1
- #1
segmentationfault
Programmer
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:
If anybody has refinements, I'd be happy to see them.
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.