算法4 vba實作快速排序

快速排序

• 快速實作
• 三向切分
• 快速三向切分

快速實作

Sub debugTest()
    Dim a() As Variant
    
    a = Array(6, 2, 5, 3, 7, 4, 6)
    
    sort a
    
    Debug.Print 1
End Sub

Sub sort(a() As Variant)
    doSort a, LBound(a), UBound(a)
End Sub

Sub doSort(a() As Variant, low As Long, high As Long)
    
    If low >= high Then Exit Sub
    
    Dim i As Long
    
    i = partition2(a, low, high)
    
    doSort a, low, i - 1
    
    doSort a, i + 1, high
    

End Sub

' 普通的分區方式
Function partition(a() As Variant, low As Long, high As Long) As Long
    ' 分區的數量
    Dim num As Long

    ' low
    Dim i As Long
    
    ' high
    Dim j As Long

    Dim key As Variant
    
    i = low
    
    j = high + 1
    
    key = a(low)
    
    Do
    
      i = i + 1
      
      Do While less(a(i), key)
        If i = high Then Exit Do
        i = i + 1
      Loop
      
      j = j - 1
      
      Do While less(key, a(j))
        If j = low Then Exit Do
        j = j - 1
      Loop
      
      If i >= j Then Exit Do
      
      exch a, i, j
      
    Loop
    
    exch a, low, j
    
    partition = j
End Function

           

三向切分

Type Tuple
    lt As Long
    gt As Long
End Type

Sub doSort2(a() As Variant, low As Long, high As Long)
    
    If low >= high Then Exit Sub
    
    Dim i As Tuple
    
    i = partition2(a, low, high)
    
    doSort2 a, low, i.lt - 1
    
    doSort2 a, i.gt + 1, high
   
End Sub

' 三向切分
' 目的是将整個數組分為3個部分 low-lt-1為小于v的部分，
' lt-i -1 為等于v的部分，
' i-gt不确定，
' gt+1 - high為大于
Function partition2(a() As Variant, low As Long, high As Long) As Tuple
    ' 分區的數量
    Dim num As Long

    ' low
    Dim i As Long
    
    ' high
    Dim gt As Long

    Dim key As Variant
    
    Dim lt As Long
    
    
    i = low
    lt = low
    
    
    gt = high
    
    key = a(low)
    
    i = i + 1
    
    Do
      
        If less(a(i), key) Then
            exch a, i, lt
            i = i + 1
            lt = lt + 1
        
        ElseIf greater(a(i), key) Then
    
            exch a, i, gt
            gt = gt - 1
        Else
            i = i + 1
        
        End If
        ' 當i=gt的時候，依然需要比較，有可能i位置比key小，如果此時i退出，狀态就錯誤了
        If i > gt Then Exit Do
      
    Loop
    
    Dim t As Tuple
    
    t.lt = lt
    
    t.gt = gt
    
End Function

           

快速三向切分

Type Tuple
    lt As Long
    gt As Long
End Type



Sub debugTest()
    Dim a() As Variant
    
    a = Array(6, 2, 5, 3, 7, 4, 6, 2, 55, 1, 3, 55, 66, 23)
    
    sort a
    
End Sub

Sub sort(a() As Variant)
    doSort a, LBound(a), UBound(a)
End Sub

Sub doSort(a() As Variant, low As Long, high As Long)
    
    If low >= high Then Exit Sub
    
    Dim i As Tuple
    
    i = partition(a, low, high)
    
    doSort a, low, i.lt
    
    doSort a, i.gt, high
    

End Sub

' 快速三向切分
' 兩端存放等于v的資料，左邊小，右邊大
' p,q,i.j
' low - p 等于v
' p - i -1 小于v

' i-j 處于移動狀态
' j + 1 - q-1 大于v
' q - high 等于v

Function partition(a() As Variant, low As Long, high As Long) As Tuple
   Dim i As Long
   Dim j As Long
   Dim p As Long
   Dim q As Long
   Dim key As Variant
   
   
   i = low
   j = high + 1
   
   p = low
   
   q = high + 1
   
   key = a(low)
   
   Do
    i = i + 1
    Do While less(a(i), key)
        If i = high Then Exit Do
        
        i = i + 1
    Loop
    
    j = j - 1
    Do While less(key, a(j))
        If j = low Then Exit Do
        j = j - 1
    Loop
    
    If i = j And eq(a(i), a(j)) Then
        p = p + 1
        exch a, i, p
    End If
    
    If i >= j Then Exit Do
    
    exch a, i, j
    
    ' 疑問，為什麼不在交換前比較，這樣，也能節省交換
    ' 未證明:在交換前比較，需要更多的比較次數。大緻思考：每次循環，這種方式隻需要比較一次，而如果在do中判斷，需要多次比較。
    If eq(a(i), key) Then
        p = p + 1
        exch a, i, p
    End If
    
    If eq(a(j), key) Then
        q = q - 1
        exch a, j, q
    End If
        
   Loop
   
   ' 還原
   
   '确定還原位置
   ' i 比v位置大
   i = j + 1
   
    Dim k As Long
    
    For k = low To p
        exch a, k, j
        j = j - 1
    Next
    
    For k = high To q Step -1
        exch a, k, i
        i = i + 1
    Next
    
    Dim t As Tuple
    
    t.lt = j
    
    t.gt = i
   
   partition = t
   
End Function


Private Function eq(i As Variant, j As Variant)
    eq = i = j
End Function

Private Function less(i As Variant, j As Variant)
    less = i < j
End Function




Sub exch(a() As Variant, i As Long, j As Long)
    Dim temp
    
    temp = a(i)
    
    a(i) = a(j)
    
    a(j) = temp
End Sub