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

' 堆排序
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)