If px(J) <= Temp Then px(I) = px(J): I = I + 1: Exit Do
这个的<=改成<
另一个也一样
程序代码:
Dim a_px(1 To 10000) As Double
Dim a_sj(1 To 10000) As Double
'Dim b_px(1 To 10000) As Double
'Dim b_sj(1 To 10000) As Double
Dim hang As Long
Dim K() As String, Num() As Double, s As Long, l As Long, px_i As Long
sub do1(file$)
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
hang = 0
Open App.Path & file For Input As #1
Do While Not EOF(1)
Line Input #1, Temp
hang = hang + 1
a_sj(hang) = Temp
Loop
Close #1
Call qsort(a_sj, 1, hang) '对数组使用二分法
For px_i = 1 To hang
a_px(px_i) = a_sj(px_i)
Next px_i
Label2.Caption = hang
Label3.Caption = a_px(1)
Label4.Caption = a_px(hang)
end sub
Private Sub Command1_Click()
do1 "\a.txt"
End Sub
Private Sub Command2_Click()
do1 "\b.txt"
End Sub
'排序方法一
Sub qsort(px() As Double, ByVal kaishi As Long, ByVal jieshu As Long)
Dim Temp As Double, J As Long, I As Long
I = kaishi: J = jieshu '将i、j作为指针,从两侧向中部移动
If kaishi < jieshu Then '控制是否进入循环
Temp = px(kaishi) '将数组第一个值赋给temp,暂时充当对比量
While I < J
Do While I < J '指针j从右向左移动,当遇到比temp小的数时,将该值移动到指针i的位置,并使i向右移动一位
'If px(J) <= Temp Then px(I) = px(J): I = I + 1: Exit Do
If px(J) < Temp Then px(I) = px(J): I = I + 1: Exit Do
J = J - 1
Loop
Do While I < J '指针i从左向右移动,当遇到比temp大的数时,将该值移动到指针j的位置,并使j向左移动一位
If px(I) > Temp Then px(J) = px(I): J = J - 1: Exit Do
I = I + 1
Loop
Wend
px(I) = Temp
Call qsort(px(), kaishi, I - 1) '递归二分法过程进行排序
Call qsort(px(), I + 1, jieshu)
Else
Exit Sub
End If
End Sub
sub do2(file$)
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
hang = 0
Open App.Path & file For Input As #1
Do While Not EOF(1)
Line Input #1, Temp
hang = hang + 1
a_sj(hang) = Temp
Loop
Close #1
l = hang: s = 1: ReDim Num(l)
For px_i = s To l
Num(px_i) = a_sj(px_i)
Next px_i
Call QUICK_SORT(s, l, Num)
For px_i = s To l
a_px(px_i) = Num(px_i)
Next px_i
Label2.Caption = hang
Label3.Caption = a_px(1)
Label4.Caption = a_px(hang)
end sub
Private Sub Command3_Click()
do2 "\a.txt"
End Sub
Private Sub Command4_Click()
do2 "\b.txt"
End Sub
Private Sub Form_Load()
Label2.Caption = ""
Label3.Caption = ""
Label4.Caption = ""
End Sub
'排序方法二
Private Function PARTITION(ByVal p As Long, ByVal r As Long, ByRef a() As Double) As Long
Dim X As Double, t As Long, I As Long, J As Long
Randomize
t = CLng((r - p) * Rnd + p)
'Call Exchange(a(r), a(t))
Dim tmp As Double
tmp = a(r): a(r) = a(t): a(t) = tmp
X = a(r): I = p - 1
For J = p To r - 1
'If a(J) <= X Then I = I + 1: Call Exchange(a(I), a(J))
If a(J) < X Then
I = I + 1
else
tmp = a(I): a(I) = a(J): a(J) = tmp
end if
Next J
'Call Exchange(a(I + 1), a(r))
tmp = a(I + 1): a(I + 1) = a(r): a(r) = tmp
PARTITION = I + 1
End Function
Private Sub QUICK_SORT(ByVal p As Long, ByVal r As Long, ByRef a() As Double)
If p < r Then
Dim q As Long
q = PARTITION(p, r, a)
Call QUICK_SORT(p, q - 1, a)
Call QUICK_SORT(q + 1, r, a)
End If
End Sub
简单修改了下,递归特别费资源,慎用。
[此贴子已经被作者于2023-7-8 00:55编辑过]