常用排序算法之堆排序与快速排序

'堆排序


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)