📄 module1.vb
字号:
Module Module1
Public Const ZERO As Short = 0
Public Const ASCENDING_ORDER As Short = 0
Public Const DESCENDING_ORDER As Short = 1
Public gIterations As Object
Sub BubbleSort(ByRef MyArray() As Object, ByVal nOrder As Short)
Dim Index As Object
Dim TEMP As Object
Dim NextElement As Object
NextElement = ZERO
Do While (NextElement < UBound(MyArray))
Index = UBound(MyArray)
Do While (Index > NextElement)
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
End If
End If
Index = Index - 1
gIterations = gIterations + 1
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
Loop
End Sub
Sub Bucket(ByRef MyArray() As Object, ByVal nOrder As Short)
Dim Index As Object
Dim NextElement As Object
Dim TheBucket As Object
NextElement = LBound(MyArray) + 1
While (NextElement <= UBound(MyArray))
TheBucket = MyArray(NextElement)
Index = NextElement
Do
If Index > LBound(MyArray) Then
If nOrder = ASCENDING_ORDER Then
If TheBucket < MyArray(Index - 1) Then
MyArray(Index) = MyArray(Index - 1)
Index = Index - 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If TheBucket >= MyArray(Index - 1) Then
MyArray(Index) = MyArray(Index - 1)
Index = Index - 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
gIterations = gIterations + 1
Loop
MyArray(Index) = TheBucket
NextElement = NextElement + 1
gIterations = gIterations + 1
End While
End Sub
Sub Heap(ByRef MyArray() As Object)
Dim Index As Object
Dim Size As Object
Dim TEMP As Object
Size = UBound(MyArray)
Index = 1
While (Index <= Size)
Call HeapSiftup(MyArray, Index)
Index = Index + 1
gIterations = gIterations + 1
End While
Index = Size
While (Index > 0)
TEMP = MyArray(0)
MyArray(0) = MyArray(Index)
MyArray(Index) = TEMP
Call HeapSiftdown(MyArray, Index - 1)
Index = Index - 1
gIterations = gIterations + 1
End While
End Sub
Sub HeapSiftdown(ByRef MyArray() As Object, ByRef M As Object)
Dim Index As Object
Dim Parent As Object
Dim TEMP As Object
Index = 0
Parent = 2 * Index
Do While (Parent <= M)
If (Parent < M And MyArray(Parent) < MyArray(Parent + 1)) Then
Parent = Parent + 1
End If
If MyArray(Index) >= MyArray(Parent) Then
Exit Do
End If
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Parent)
MyArray(Parent) = TEMP
Index = Parent
Parent = 2 * Index
gIterations = gIterations + 1
Loop
End Sub
Sub HeapSiftup(ByRef MyArray() As Object, ByRef M As Object)
Dim Index As Object
Dim Parent As Object
Dim TEMP As Object
Index = M
Do While (Index > 0)
Parent = Int(Index / 2)
If MyArray(Parent) >= MyArray(Index) Then
Exit Do
End If
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Parent)
MyArray(Parent) = TEMP
Index = Parent
gIterations = gIterations + 1
Loop
End Sub
Sub Insertion(ByRef MyArray() As Object, ByVal nOrder As Short)
Dim Index As Object
Dim TEMP As Object
Dim NextElement As Object
NextElement = LBound(MyArray) + 1
While (NextElement <= UBound(MyArray))
Index = NextElement
Do
If Index > LBound(MyArray) Then
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
Index = Index - 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - 1) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - 1)
MyArray(Index - 1) = TEMP
Index = Index - 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
gIterations = gIterations + 1
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
End While
End Sub
Sub QuickSort(ByRef MyArray() As Object, ByRef L As Object, ByRef R As Object)
Dim X, I, J, Y As Object
I = L
J = R
X = MyArray((L + R) / 2)
While (I <= J)
While (MyArray(I) < X And I < R)
I = I + 1
End While
While (X < MyArray(J) And J > L)
J = J - 1
End While
If (I <= J) Then
Y = MyArray(I)
MyArray(I) = MyArray(J)
MyArray(J) = Y
I = I + 1
J = J - 1
End If
gIterations = gIterations + 1
End While
If (L < J) Then Call QuickSort(MyArray, L, J)
If (I < R) Then Call QuickSort(MyArray, I, R)
End Sub
Sub Selection(ByRef MyArray() As Object, ByVal nOrder As Short)
Dim Index As Object
Dim Min As Object
Dim NextElement As Object
Dim TEMP As Object
NextElement = 0
While (NextElement < UBound(MyArray))
Min = UBound(MyArray)
Index = Min - 1
While (Index >= NextElement)
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Min) Then
Min = Index
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Min) Then
Min = Index
End If
End If
Index = Index - 1
gIterations = gIterations + 1
End While
TEMP = MyArray(Min)
MyArray(Min) = MyArray(NextElement)
MyArray(NextElement) = TEMP
NextElement = NextElement + 1
gIterations = gIterations - 1
End While
End Sub
Sub ShellSort(ByRef MyArray() As Object, ByVal nOrder As Short)
Dim Distance As Object
Dim Size As Object
Dim Index As Object
Dim NextElement As Object
Dim TEMP As Object
Size = UBound(MyArray) - LBound(MyArray) + 1
Distance = 1
While (Distance <= Size)
Distance = 2 * Distance
End While
Distance = (Distance / 2) - 1
While (Distance > 0)
NextElement = LBound(MyArray) + Distance
While (NextElement <= UBound(MyArray))
Index = NextElement
Do
If Index >= (LBound(MyArray) + Distance) Then
If nOrder = ASCENDING_ORDER Then
If MyArray(Index) < MyArray(Index - Distance) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - Distance)
MyArray(Index - Distance) = TEMP
Index = Index - Distance
gIterations = gIterations + 1
Else
Exit Do
End If
ElseIf nOrder = DESCENDING_ORDER Then
If MyArray(Index) >= MyArray(Index - Distance) Then
TEMP = MyArray(Index)
MyArray(Index) = MyArray(Index - Distance)
MyArray(Index - Distance) = TEMP
Index = Index - Distance
gIterations = gIterations + 1
Else
Exit Do
End If
End If
Else
Exit Do
End If
Loop
NextElement = NextElement + 1
gIterations = gIterations + 1
End While
Distance = (Distance - 1) / 2
gIterations = gIterations + 1
End While
End Sub
End Module
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -