'堆排序
Option Explicit
Dim Result, I
Dim TestData(100)
const N = 100
Randomize
For I = 0 To N - 1
TestData(I) = ROUND(RND() * 32768)
Next
'堆排序
Sub HSort(byRef Array, low, hi)
Dim i, t, j, p, l, r
For i = hi To low + 1 Step -1
j = i
p = Int((j-low+1)/2)+low-1
t = Array(j)
Do
If p = low-1 Then
Exit Do
End If
If t > Array(p) Then
Array(j) = Array(p)
j = p
p = Int((j-low+1)/2)+low-1
Else
Exit Do
End If
Loop
Array(j) = t
Next
For i = hi To low + 1 Step -1
t = Array(i)
Array(i) = Array(low)
j = low
Do
l = (j-low+1)*2+low-1
If l < i Then
r = (j-low+1)*2+low
If r < i Then
If Array(l) < Array(r) Then
l = r
End If
End If
If t < Array(l) Then
Array(j) = Array(l)
j = l
Else
Exit Do
End If
Else
Exit Do
End If
Loop
Array(j) = t
Next
End Sub
HSort TestData, 0, N - 1
For I = 0 To N - 1
Result = Result & TestData(I) & VbTab
Next
MsgBox(Result)
Option Explicit
Dim Result, I
Dim TestData(100)
const N = 100
Randomize
For I = 0 To N - 1
TestData(I) = ROUND(RND() * 32768)
Next
'堆排序
Sub HSort(byRef Array, low, hi)
Dim i, t, j, p, l, r
For i = hi To low + 1 Step -1
j = i
p = Int((j-low+1)/2)+low-1
t = Array(j)
Do
If p = low-1 Then
Exit Do
End If
If t > Array(p) Then
Array(j) = Array(p)
j = p
p = Int((j-low+1)/2)+low-1
Else
Exit Do
End If
Loop
Array(j) = t
Next
For i = hi To low + 1 Step -1
t = Array(i)
Array(i) = Array(low)
j = low
Do
l = (j-low+1)*2+low-1
If l < i Then
r = (j-low+1)*2+low
If r < i Then
If Array(l) < Array(r) Then
l = r
End If
End If
If t < Array(l) Then
Array(j) = Array(l)
j = l
Else
Exit Do
End If
Else
Exit Do
End If
Loop
Array(j) = t
Next
End Sub
HSort TestData, 0, N - 1
For I = 0 To N - 1
Result = Result & TestData(I) & VbTab
Next
MsgBox(Result)
'快速排序
Option Explicit
Dim Result, I
Dim TestData(100)
const N = 100
Randomize
For I = 0 To N - 1
TestData(I) = ROUND(RND() * 32768)
Next
Sub Swap(byRef Array, first, second)
Dim t
t = Array(first)
Array(first) = Array(second)
Array(second) = t
End Sub
'快速排序
Sub QSort(byRef Array, low, hi)
Dim i, j, p
While low < hi
p = Array(hi)
i = low - 1
For j = low To hi-1
If Array(j) <= p Then
i = i + 1
Swap Array, i, j
End If
Next
Swap Array, i+1, j
QSort Array, low, i
low = i + 2
Wend
End Sub
QSort TestData, 0, N - 1
For I = 0 To N - 1
Result = Result & TestData(I) & VbTab
Next
MsgBox(Result)
Option Explicit
Dim Result, I
Dim TestData(100)
const N = 100
Randomize
For I = 0 To N - 1
TestData(I) = ROUND(RND() * 32768)
Next
Sub Swap(byRef Array, first, second)
Dim t
t = Array(first)
Array(first) = Array(second)
Array(second) = t
End Sub
'快速排序
Sub QSort(byRef Array, low, hi)
Dim i, j, p
While low < hi
p = Array(hi)
i = low - 1
For j = low To hi-1
If Array(j) <= p Then
i = i + 1
Swap Array, i, j
End If
Next
Swap Array, i+1, j
QSort Array, low, i
low = i + 2
Wend
End Sub
QSort TestData, 0, N - 1
For I = 0 To N - 1
Result = Result & TestData(I) & VbTab
Next
MsgBox(Result)