VB QuickSort

testid 发表于 2011-12-1 12:02:18

Option Explicit

Private Sub QuicksortInt(list() As Integer, ByVal min As Integer, ByVal max As Integer)
Dim med_value As Integer
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortInt list(), min, lo - 1
QuicksortInt list(), lo + 1, max
End Sub
Private Sub QuicksortSingle(list() As Single, ByVal min As Integer, ByVal max As Integer)
Dim med_value As Single
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortSingle list(), min, lo - 1
QuicksortSingle list(), lo + 1, max
End Sub
Private Sub QuicksortDouble(list() As Double, ByVal min As Integer, ByVal max As Integer)
Dim med_value As Double
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortDouble list(), min, lo - 1
QuicksortDouble list(), lo + 1, max
End Sub
Private Sub QuicksortString(list() As String, ByVal min As Integer, ByVal max As Integer)
Dim med_value As String
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortString list(), min, lo - 1
QuicksortString list(), lo + 1, max
End Sub
Private Sub QuicksortVariant(list() As Variant, ByVal min As Integer, ByVal max As Integer)
Dim med_value As Variant
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortVariant list(), min, lo - 1
QuicksortVariant list(), lo + 1, max
End Sub

Private Sub QuicksortLong(list() As Long, ByVal min As Integer, ByVal max As Integer)
Dim med_value As Long
Dim hi As Integer
Dim lo As Integer
Dim i As Integer

' If the list has no more than CutOff elements,
' finish it off with SelectionSort.
If max <= min Then Exit Sub

' Pick the dividing value.
i = Int((max - min + 1) * Rnd + min)
med_value = list(i)

' Swap it to the front.
list(i) = list(min)

lo = min
hi = max
Do
   ' Look down from hi for a value < med_value.
   Do While list(hi) >= med_value
         hi = hi - 1
         If hi <= lo Then Exit Do
   Loop
   If hi <= lo Then
         list(lo) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(lo) = list(hi)

   ' Look up from lo for a value >= med_value.
   lo = lo + 1
   Do While list(lo) < med_value
         lo = lo + 1
         If lo >= hi Then Exit Do
   Loop
   If lo >= hi Then
         lo = hi
         list(hi) = med_value
         Exit Do
   End If

   ' Swap the lo and hi values.
   list(hi) = list(lo)
Loop

' Sort the two sublists.
QuicksortLong list(), min, lo - 1
QuicksortLong list(), lo + 1, max
End Sub

' Sort an array of integers.
Public Sub SortIntArray(list() As Integer)
QuicksortInt list, LBound(list), UBound(list)
End Sub
' Sort an array of longs.
Public Sub SortLongArray(list() As Long)
QuicksortLong list, LBound(list), UBound(list)
End Sub
' Sort an array of singles.
Public Sub SortSingleArray(list() As Single)
QuicksortSingle list, LBound(list), UBound(list)
End Sub
' Sort an array of doubles.
Public Sub SortDoubleArray(list() As Double)
QuicksortDouble list, LBound(list), UBound(list)
End Sub
' Sort an array of strings.
Public Sub SortStringArray(list() As String)
QuicksortString list, LBound(list), UBound(list)
End Sub
' Sort an array of variants.
Public Sub SortVariantArray(list() As Variant)
QuicksortVariant list, LBound(list), UBound(list)
End Sub

马大哈 发表于 2011-12-2 14:54:34

建议增加使用示例......

Tesla.Angela 发表于 2011-12-2 16:10:11

马大哈发表于 2011-12-2 14:54 static/image/common/back.gif
建议增加使用示例......

老马，这还要使用示例吗？明眼人一下子就看明白了啊：
' Sort an array of integers.

Public Sub SortIntArray(list() As Integer)

QuicksortInt list, LBound(list), UBound(list)

End Sub

' Sort an array of longs.

Public Sub SortLongArray(list() As Long)

QuicksortLong list, LBound(list), UBound(list)

End Sub

' Sort an array of singles.

Public Sub SortSingleArray(list() As Single)

QuicksortSingle list, LBound(list), UBound(list)

End Sub

' Sort an array of doubles.

Public Sub SortDoubleArray(list() As Double)

QuicksortDouble list, LBound(list), UBound(list)

End Sub

' Sort an array of strings.

Public Sub SortStringArray(list() As String)

QuicksortString list, LBound(list), UBound(list)

End Sub

' Sort an array of variants.

Public Sub SortVariantArray(list() As Variant)

QuicksortVariant list, LBound(list), UBound(list)

End Sub

马大哈 发表于 2011-12-4 00:33:21

Tesla.Angela 发表于 2011-12-2 16:10 static/image/common/back.gif
老马，这还要使用示例吗？明眼人一下子就看明白了啊：

还是要考虑初学者啊.

不是所有人都一上来就会使用的,嘿嘿.

我的那些模块不也封装得很简单么?而且还写了示例.

结果还不是一大堆人问用法.

页: [1]

紫水晶编程技术论坛 - 努力打造成全国最好的编程论坛's Archiver

VB QuickSort