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

Question

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

Answer 1

不是吧..哪位高手帮忙给解决下撒..SOS

Answer 2

大家帮帮忙啊.没用VB做过这个.要是换C++我就做出来了.现在是在VB里老转化不过来.总出错. 帮帮忙咯

Answer 3

好歹是CSDN啊,怎么都没人帮忙搞下 ? 是能力不足还是什么咯 ? 真是失望.我自己又搞了两个了.还有归并和基数了.看哪位前辈帮帮忙啊.我的总出错了。 要这样下去,我怀疑着帖子怎么结呢!!!

Answer 4

o 还差归并和基数啊.归并的怎么也调试不对.基数的要指针,可是VB没有啊..不晓得怎么转化一下.等我搞出来,一定公布..大家也都帮帮忙撒..

Answer 5

//归并排序的,不知道哪里错了.大家帮忙给调试下,提点建议//
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 FunctionPrivate 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 FunctionPrivate 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 FunctionPrivate 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 IfEnd FunctionPrivate Sub Command1_Click()Call mergesort(5)
For i = 1 To 5
Print r(i)
Next
Print
End SubPrivate Sub Form_Activate()
For i = 1 To 5
r(i) = Int(90 * Rnd + 10)
Print r(i)
NextPrint
End Sub

Answer 6

//归并可以了。大家再帮看看基数的。这个在VC++里用到了指针,大家看在VB里怎么搞.谢谢//
//这个是搞好的归并的//
Dim pivotpos As Integer
Dim r(101), m(101) As IntegerPrivate 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 - 1Loop
r(j) = ci = i + 1LoopFor i = 1 To 8
Me.Print r(i)
Next
Print
End SubPrivate 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 SubPrivate Sub Command3_Click()
Call quicksort(1, 8)
For i = 1 To 8
Print r(i)
Next
Print
End SubPrivate 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 SubPrivate Sub Form_Activate()Dim i As Integer
For i = 1 To 8
r(i) = Int(90 * Rnd + 10)
Print r(i)
NextPrint
End SubPrivate Function quicksort(low As Integer, high As Integer) '快速排序
Dim i, j, t As IntegerIf (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 FunctionPrivate 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 SubPrivate 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 IfEnd Function

Answer 7

//不好意思,把全部的都发了,发错了.下边是归并的//
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 SubPrivate 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 IfEnd FunctionPrivate 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

Answer 8

献丑了：
下面是用到堆栈的一个快速排序法的类模块。把它复制在一个class里面就可以用了
Option Explicit'///////////////////////////////////////////////////////////////
'// QucikSort_V2 function class
'//
'// LastUpdate:2004-1-22
'// by Kwanhong Young (r4c Studio)
'///////////////////////////////////////////////////////////////Private stack       As cStack_longPrivate Sub Class_Initialize()
    Set stack = New cStack_long
End SubPrivate Sub Class_Terminate()
    Set stack = Nothing
End SubPublic 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 SubPrivate 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 SubPrivate 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

Answer 9

上面的类会用到一个叫 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 LongPrivate Sub Class_Initialize()
'//start...
    ReDim sItem(0)
    iCount = 0
End SubPrivate Sub Class_Terminate()
'//over
    ReDim sItem(0)
    iCount = 0
End SubPublic Sub Push(ByVal vValue As Long)
    sItem(iCount) = vValue
    iCount = iCount + 1
    ReDim Preserve sItem(iCount)
End SubPublic Function Pop() As Long
    If iCount > 0 Then
        iCount = iCount - 1
        Pop = sItem(iCount)
        ReDim Preserve sItem(iCount)
    End If
End FunctionPublic Function Peek() As Long
    If iCount > 0 Then Peek = sItem(iCount - 1)
End FunctionPublic Property Get Count() As Long
    Count = iCount
End PropertyPublic Sub GetAllItem(itm() As Long)
    ReDim itm(iCount)
    Dim i   As Long
    For i = 0 To iCount - 1
        itm(i) = sItem(i)
    Next
End SubPublic 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