请问在VB中,如何编制快速排序,堆排序,归并排序,基数排序???

pandali 2004-09-30 08:46:19
请问在VB中,如何编制快速排序,堆排序,归并排序,基数排序???
...全文
403 17 打赏 收藏 转发到动态 举报
写回复
用AI写文章
17 条回复
切换为时间正序
请发表友善的回复…
发表回复
pandali 2004-10-06
  • 打赏
  • 举报
回复
不是吧.你都有星星了啊.不是有星星的都是高手么 ?
kmzs 2004-10-06
  • 打赏
  • 举报
回复
对我来说太难了。。。
pandali 2004-10-06
  • 打赏
  • 举报
回复
大家帮忙撒....................好多天了怎么都没人帮啊?
pandali 2004-10-06
  • 打赏
  • 举报
回复
//归并排序的,不知道哪里错了.大家帮忙给调试下,提点建议//
Dim r(101), m(101) As Integer
Private Function mergesort(n As Integer)

s = 1
Do While s < n
Call mergepass1(s, n)
s = 2 * s
Call mergepass2(s, n)
s = 2 * s
Loop
End Function

Private Function mergepass1(ByVal s As Integer, ByVal n As Integer)
i = 0
Do While i <= n - 2 * s
Call merge(i, i + s - 1, i + 2 * s - 1)
i = i + 2 * s
Loop
If i + s < n Then
Call merge(i, i + s - 1, n - 1)
Else
j = i
Do While j <= n - 1
m(j) = r(j)
j = j + 1
Loop
End If
End Function

Private Function mergepass2(ByVal s As Integer, ByVal n As Integer)
i = 0
Do While i <= n - 2 * s
Call merge(i, i + s - 1, i + 2 * s - 1)
i = i + 2 * s
Loop
If i + s < n Then
Call merge(i, i + s - 1, n - 1)
Else
j = i
Do While j <= n - 1
r(j) = m(j)
j = j + 1
Loop
End If
End Function

Private Function merge(ByVal l As Integer, ByVal x As Integer, ByVal y As Integer)
i = l
j = x + 1
k = l
Do While (i <= x And j <= y)
If r(i) <= r(j) Then
m(k) = r(i)
k = k + 1
i = i + 1
Else
m(k) = r(j)
k = k + 1
j = j + 1
End If
Loop
If i > x Then
q = j
Do While q <= y
m(k) = r(q)
k = k + 1
q = q + 1
Loop
Else
q = i
Do While q <= x
m(k) = r(q)
k = k + 1
q = q + 1
Loop
End If

End Function

Private Sub Command1_Click()

Call mergesort(5)
For i = 1 To 5
Print r(i)
Next
Print
End Sub

Private Sub Form_Activate()
For i = 1 To 5
r(i) = Int(90 * Rnd + 10)
Print r(i)
Next

Print
End Sub
VirtualAlloc 2004-10-06
  • 打赏
  • 举报
回复
上面的类会用到一个叫 Stack_long 的“堆栈”类,代码如下:

Option Explicit

'-----------------------------------------------------------------------
'堆栈 (stack) - FOR LONG DATA TYPE
'数据结构中的 Stack, 有Push、Pop、Peek等方法
'
'LastUpdate:2004-1-23
'by Kwanhong Young (r4c Studio)
'-----------------------------------------------------------------------

Private sItem() As Long
Private iCount As Long

Private Sub Class_Initialize()
'//start...
ReDim sItem(0)
iCount = 0
End Sub

Private Sub Class_Terminate()
'//over
ReDim sItem(0)
iCount = 0
End Sub

Public Sub Push(ByVal vValue As Long)
sItem(iCount) = vValue
iCount = iCount + 1
ReDim Preserve sItem(iCount)
End Sub

Public Function Pop() As Long
If iCount > 0 Then
iCount = iCount - 1
Pop = sItem(iCount)
ReDim Preserve sItem(iCount)
End If
End Function

Public Function Peek() As Long
If iCount > 0 Then Peek = sItem(iCount - 1)
End Function

Public Property Get Count() As Long
Count = iCount
End Property

Public Sub GetAllItem(itm() As Long)
ReDim itm(iCount)
Dim i As Long
For i = 0 To iCount - 1
itm(i) = sItem(i)
Next
End Sub

Public Function GetAllItem_toString(Optional ByVal cDelimiter As String = "|") As String
If iCount = 0 Then Exit Function
GetAllItem_toString = Join(sItem, cDelimiter) '//VB6

'//--------------------------------------------- //VB5
'Dim i As Long
'Dim strTmp As String
'For i = 0 To iCount - 1
' strTmp = strTmp & sItem(i) & cDelimiter
'Next
'GetAllItem_toString = Left(strTmp, Len(strTmp) - 1)

End Function
VirtualAlloc 2004-10-06
  • 打赏
  • 举报
回复
献丑了:
下面是用到堆栈的一个快速排序法的类模块。把它复制在一个class里面就可以用了


Option Explicit

'///////////////////////////////////////////////////////////////
'// QucikSort_V2 function class
'//
'// LastUpdate:2004-1-22
'// by Kwanhong Young (r4c Studio)
'///////////////////////////////////////////////////////////////

Private stack As cStack_long

Private Sub Class_Initialize()
Set stack = New cStack_long
End Sub

Private Sub Class_Terminate()
Set stack = Nothing
End Sub

Public Sub StartSort_Long(vArray() As Long)
Dim iLow As Long
Dim iHi As Long

'//get range of array
iLow = LBound(vArray) '//Low bound
iHi = UBound(vArray) '//High bound

'//push low value to stack first
stack.Push iLow
stack.Push iHi

'//use STACK, not RECURSION
Do
iHi = stack.Pop
iLow = stack.Pop
QuickSort_Long vArray(), iLow, iHi '//call the procedure
Loop Until stack.Count = 0

End Sub

Private Sub QuickSort_Long(vArray() As Long, iLow As Long, iHi As Long)
'//QuickSort procedure
'//vArray() The array to sort
'//iLow Lower bound of sort point
'//iHi Upper bound of sort point

Dim iMid As Long '//middle value
Dim tmpSwap As Long '//variou for swap function

'//two working pointer
Dim tmpLow As Long
Dim tmpHi As Long

'//Save to the working pointer
tmpLow = iLow
tmpHi = iHi

'//Get middle value
iMid = vArray((iLow + iHi) \ 2)

Do While (tmpLow <= tmpHi)

'//look up the first value that large than MIDDLE
Do While (vArray(tmpLow) < iMid And tmpLow < iHi)
tmpLow = tmpLow + 1
Loop

'//loop up the first value the small than MIDDLE
Do While (iMid < vArray(tmpHi) And tmpHi > iLow)
tmpHi = tmpHi - 1
Loop

'//swap the two items.
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
'//swap ok
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If

Loop

'//do the remain - RECURSION METHOD
'If (iLow < tmpHi) Then QuickSort_Long vArray, iLow, tmpHi
'If (tmpLow < iHi) Then QuickSort_Long vArray, tmpLow, iHi

'//do the remain - STACK METHOD
If (tmpLow < iHi) Then
stack.Push tmpLow
stack.Push iHi
End If

If (iLow < tmpHi) Then
stack.Push iLow
stack.Push tmpHi
End If


End Sub


'----------------------------------------- FOR STRING DATA TYPE ------------------------------------


Public Sub StartSort_String(vArray() As String)
Dim iLow As Long
Dim iHi As Long

'//get range of array
iLow = LBound(vArray) '//Low bound
iHi = UBound(vArray) '//High bound

'//push low value to stack first
stack.Push iLow
stack.Push iHi

'//use STACK, not RECURSION
Do
iHi = stack.Pop
iLow = stack.Pop
QuickSort_String vArray(), iLow, iHi '//call the procedure
Loop Until stack.Count = 0

End Sub

Private Sub QuickSort_String(vArray() As String, iLow As Long, iHi As Long)
'//QuickSort procedure
'//vArray() The array to sort
'//iLow Lower bound of sort point
'//iHi Upper bound of sort point

Dim iMid As String '//middle value
Dim tmpSwap As String '//variou for swap function

'//two working pointer
Dim tmpLow As Long
Dim tmpHi As Long

'//Save to the working pointer
tmpLow = iLow
tmpHi = iHi

'//Get middle value
iMid = vArray((iLow + iHi) \ 2)

Do While (tmpLow <= tmpHi)

'//look up the first value that large than MIDDLE
Do While (vArray(tmpLow) < iMid And tmpLow < iHi)
tmpLow = tmpLow + 1
Loop

'//loop up the first value the small than MIDDLE
Do While (iMid < vArray(tmpHi) And tmpHi > iLow)
tmpHi = tmpHi - 1
Loop

'//swap the two items.
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
'//swap ok
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If

Loop

'//do the remain - STACK METHOD
If (tmpLow < iHi) Then
stack.Push tmpLow
stack.Push iHi
End If

If (iLow < tmpHi) Then
stack.Push iLow
stack.Push tmpHi
End If


End Sub



pandali 2004-10-06
  • 打赏
  • 举报
回复
//不好意思,把全部的都发了,发错了.下边是归并的//
Dim r(101), m(101) As Integer
Private Sub mergesort(r() As Integer, n As Integer)
Dim m(101) As Integer
s = 1
Do While s < n
Call mergepass(r(), m(), s, n)
s = 2 * s
Call mergepass(m(), r(), s, n)
s = 2 * s
Loop
End Sub

Private Sub mergepass(r() As Integer, m() As Integer, ByVal s As Integer, ByVal n As Integer)

i = 0
Do While i <= n - 2 * s
Call merge(r(), m(), i, i + s - 1, i + 2 * s - 1)
i = i + 2 * s
Loop
If i + s < n Then
Call merge(r(), m(), i, i + s - 1, n - 1)
Else
j = i
Do While j <= n - 1
m(j) = r(j)
j = j + 1
Loop
End If
End Sub


Private Function merge(r() As Integer, m() As Integer, ByVal l As Integer, ByVal x As Integer, ByVal y As Integer)
i = l
j = x + 1
k = l
Do While (i <= x And j <= y)
If r(i) <= r(j) Then
m(k) = r(i)
k = k + 1
i = i + 1
Else
m(k) = r(j)
k = k + 1
j = j + 1
End If
Loop
If i > x Then
q = j
Do While q <= y
m(k) = r(q)
k = k + 1
q = q + 1
Loop
Else
q = i
Do While q <= x
m(k) = r(q)
k = k + 1
q = q + 1
Loop
End If

End Function

Private Sub Command1_Click()
Dim r(101) As Integer
Randomize
For i = 0 To 9
r(i) = Int(90 * Rnd + 10)
Print r(i)
Next
Print
Call mergesort(r(), 10)
For i = 0 To 9
Print r(i)
Next
Print
End Sub

pandali 2004-10-06
  • 打赏
  • 举报
回复
//归并可以了。大家再帮看看基数的。这个在VC++里用到了指针,大家看在VB里怎么搞.谢谢//
//这个是搞好的归并的//
Dim pivotpos As Integer
Dim r(101), m(101) As Integer

Private Sub Command1_Click()
i = 1
Do While i <= 8
c = r(i)
j = i
Do While (j > 0 And c < r(j - 1))
r(j) = r(j - 1)
j = j - 1

Loop
r(j) = c

i = i + 1

Loop

For i = 1 To 8
Me.Print r(i)
Next
Print
End Sub

Private Sub Command2_Click()
i = 1
Do While i <= 8
j = 1
Do While j <= 8 - i
If r(j) > r(j + 1) Then
c = r(j)
r(j) = r(j + 1)
r(j + 1) = c
End If
j = j + 1
Loop
i = i + 1
Loop
For i = 1 To 8
Print r(i)
Next
Print
End Sub

Private Sub Command3_Click()
Call quicksort(1, 8)
For i = 1 To 8
Print r(i)
Next
Print
End Sub

Private Sub Command4_Click()
Dim i As Integer
Call heapsort(9)
For i = 1 To 8
Print r(i)
Next
Print
End Sub


Private Sub Command5_Click() '有问题

Dim r(101) As Integer
Randomize
For i = 0 To 9
r(i) = Int(90 * Rnd + 10)
Print r(i)
Next
Print
Call mergesort(r(), 10)
For i = 0 To 9
Print r(i)
Next
Print
End Sub



Private Sub Form_Activate()

Dim i As Integer
For i = 1 To 8
r(i) = Int(90 * Rnd + 10)
Print r(i)
Next

Print
End Sub

Private Function quicksort(low As Integer, high As Integer) '快速排序
Dim i, j, t As Integer

If (low < high) Then
i = low
j = high
t = r(low)
Do While i < j
Do While i < j And r(j) > t
j = j - 1
Loop
If i < j Then
r(i) = r(j)
i = i + 1
End If
Do While i < j And r(i) <= t
i = i + 1
Loop
If i < j Then
r(j) = r(i)
j = j - 1
End If
Loop
r(i) = t
Call quicksort(low, i - 1)
Call quicksort(i + 1, high)
End If

End Function


Private Function sift(ByVal n As Integer, ByVal s As Integer) '渗透建堆
Dim t, k, j As Integer
t = r(s)
k = s
j = 2 * k + 1
Do While j < n
If j < n - 1 And r(j) < r(j + 1) Then
j = j + 1
End If
If (t < r(j)) Then
r(k) = r(j)
k = j
j = 2 * k + 1
Else
GoTo mmm

End If
Loop
mmm: r(k) = t
End Function

Private Function heapsort(ByVal n As Integer) '堆排序
Dim k, t, i As Integer
i = n / 2 - 1
Do While i >= 0
Call sift(n, i)
i = i - 1
Loop
k = n - 1
Do While k >= 1
t = r(0)
r(0) = r(k)
r(k) = t
Call sift(k, 0)
k = k - 1
Loop
End Function
Private Sub mergesort(r() As Integer, n As Integer)
Dim m(101) As Integer
s = 1
Do While s < n
Call mergepass(r(), m(), s, n)
s = 2 * s
Call mergepass(m(), r(), s, n)
s = 2 * s
Loop
End Sub

Private Sub mergepass(r() As Integer, m() As Integer, ByVal s As Integer, ByVal n As Integer)

i = 0
Do While i <= n - 2 * s
Call merge(r(), m(), i, i + s - 1, i + 2 * s - 1)
i = i + 2 * s
Loop
If i + s < n Then
Call merge(r(), m(), i, i + s - 1, n - 1)
Else
j = i
Do While j <= n - 1
m(j) = r(j)
j = j + 1
Loop
End If
End Sub


Private Function merge(r() As Integer, m() As Integer, ByVal l As Integer, ByVal x As Integer, ByVal y As Integer)
i = l
j = x + 1
k = l
Do While (i <= x And j <= y)
If r(i) <= r(j) Then
m(k) = r(i)
k = k + 1
i = i + 1
Else
m(k) = r(j)
k = k + 1
j = j + 1
End If
Loop
If i > x Then
q = j
Do While q <= y
m(k) = r(q)
k = k + 1
q = q + 1
Loop
Else
q = i
Do While q <= x
m(k) = r(q)
k = k + 1
q = q + 1
Loop
End If

End Function
pandali 2004-10-03
  • 打赏
  • 举报
回复
o 还差归并和基数啊.归并的怎么也调试不对.基数的要指针,可是VB没有啊..不晓得怎么转化一下.等我搞出来,一定公布..大家也都帮帮忙撒..
pandali 2004-10-02
  • 打赏
  • 举报
回复
好歹是CSDN啊,怎么都没人帮忙搞下 ? 是能力不足还是什么咯 ? 真是失望.我自己又搞了两个了.还有归并和基数了.看哪位前辈帮帮忙啊.我的总出错了。 要这样下去,我怀疑着帖子怎么结呢!!!
wumylove1234 2004-10-02
  • 打赏
  • 举报
回复
把你写的公布出来让我们学习一下啊.~
pandali 2004-10-01
  • 打赏
  • 举报
回复
大家帮帮忙啊.没用VB做过这个.要是换C++我就做出来了.现在是在VB里老转化不过来.总出错. 帮帮忙咯
haiz_2001 2004-09-30
  • 打赏
  • 举报
回复
好象很难
我正想办法实现
可惜没有指针
northwolves 2004-09-30
  • 打赏
  • 举报
回复
找 分儿910,他写过许多
pandali 2004-09-30
  • 打赏
  • 举报
回复
不是吧..哪位高手帮忙给解决下撒..SOS
jam021 2004-09-30
  • 打赏
  • 举报
回复
关注,帮你顶!
PrettyMurphy 2004-09-30
  • 打赏
  • 举报
回复
好像VB也可以位操作吧?

7,759

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧