Dual-Pivot Quicksort

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte ein Array sortieren.

Lösung

'Portierung aus Java des Dual-Pivot Quicksort, wie von Vladimir Yaroslavskiy im
'Februar 2009 vorgeschlagen, jetzt die Standard-Array-Sorting-algo in den offi-
'ziellen JDK-Quellen:
'http://cr.openjdk.java.net/~alanb/6880672/webrev.00/src/share/classes/java/util/Arrays.java.html
Public Sub DualPivotQuickSort(Arr() As String, _
                              ind() As Long, _
                              LB As Long, _
                              UB As Long)
   Dim i   As Long
   Dim j   As Long
   Dim M1  As Long
   Dim M2  As Long
   Dim P1  As Long
   Dim P2  As Long
   Dim Tmp As Long  '<- Typen hier anpassen
 
   If (UB - LB) < 27 Then  'Einfügesortierung für verbleibende kleine Bereiche
      For i = LB To UB - 1
         Tmp = ind(i + 1)
         For j = i To LB Step -1
            If Arr(Tmp) < Arr(ind(j)) Then ind(j + 1) = ind(j) Else Exit For
         Next
         ind(j + 1) = Tmp
      Next
      Exit Sub
   End If
 
   M1 = LB + (UB - LB) \ 3: M2 = UB - M1 + LB   'Mittelwerte
 
   If Arr(ind(M1)) < Arr(ind(M2)) Then i = LB: j = UB Else i = UB: j = LB
   Tmp = ind(M1): ind(M1) = ind(i): ind(i) = Tmp
   Tmp = ind(M2): ind(M2) = ind(j): ind(j) = Tmp
 
   P1 = ind(LB): P2 = ind(UB)  'Dehpunkte
   M1 = LB + 1: M2 = UB - 1    '... und Mediane wurden in "Pointer" umgewandelt.
 
   'Sortierung
   i = M1 - 1
   Do While i < M2  '<- M2 nimmt innerhalb dieser Schleife ab,
                    '   so dass wir keinen For Next verwenden können.
      i = i + 1
 
      If Arr(P1) > Arr(ind(i)) Then
         Tmp = ind(i): ind(i) = ind(M1): ind(M1) = Tmp
         M1 = M1 + 1
      ElseIf Arr(P2) < Arr(ind(i)) Then
         Do While M2 > i
            If Arr(P2) < Arr(ind(M2)) Then M2 = M2 - 1 Else Exit Do
         Loop
 
         If Arr(P1) <= Arr(ind(M2)) Then
            Tmp = ind(i): ind(i) = ind(M2): ind(M2) = Tmp
            M2 = M2 - 1
         Else
            Tmp = ind(i): ind(i) = ind(M1): ind(M1) = ind(M2): ind(M2) = Tmp
            M2 = M2 - 1: M1 = M1 + 1
         End If
      End If
   Loop
 
   Tmp = ind(M1 - 1): ind(M1 - 1) = ind(LB): ind(LB) = Tmp
   Tmp = ind(M2 + 1): ind(M2 + 1) = ind(UB): ind(UB) = Tmp
 
   DualPivotQuickSort Arr, ind, LB, M1 - 2  'Wiederholung in unteres Subarray
   DualPivotQuickSort Arr, ind, M2 + 2, UB  'Wiederholung in oberes Subarray
 
   If (M2 - M1) > (UB - LB - 21) Then  'gleiche Elemente behandeln
      If Arr(P1) <> Arr(P2) Then
         i = M1 - 1
         Do While i < M2   '<- M2 nimmt innerhalb dieser Schleife ab,
                           '   so dass wir keinen For Next verwenden können.
            i = i + 1
            If Arr(P1) = Arr(ind(i)) Then
               ind(i) = ind(M1): ind(M1) = P1
               M1 = M1 + 1
            ElseIf Arr(P2) = Arr(ind(i)) Then
               If Arr(P1) <> Arr(ind(M2)) Then
                  ind(i) = ind(M2): ind(M2) = P2
                  M2 = M2 - 1
               Else
                  ind(i) = ind(M1): ind(M1) = P1: ind(M2) = P2
                  M2 = M2 - 1: M1 = M1 + 1
               End If
            End If
         Loop
      End If
   End If
 
   'in das verbleibende Subarray zurückkehren
   If Arr(P1) < Arr(P2) Then DualPivotQuickSort Arr, ind, M1, M2
End Sub

Beispielaufruf

Function RndString(Optional Chars As String = "ABCDEFGHIJKLMNOPQRSTUVWXYZ", _
                   Optional MinLen As Long = 1, _
                   Optional MaxLen As Long = 20) As String
  Dim CharsLen As Long
  Dim i        As Long
  Dim n        As Long
 
  'Länge(n) bestimmen:
  CharsLen = Len(Chars)
  n = Int((MaxLen - MinLen + 1) * Rnd) + MinLen
  RndString = Space$(n)
 
  'Zufällige Zeichen einfügen:
  For i = 1 To n
    n = Int(CharsLen * Rnd) + 1
    Mid$(RndString, i) = Mid$(Chars, n, 1)
  Next
End Function
 
 
Sub Demo()
   Dim Demo(99) As String, ind(99) As Long, i As Long
 
   For i = 0 To 99
      Demo(i) = RndString(, 4, 4)
      ind(i) = i
   Next
 
   DualPivotQuickSort Demo, ind, 0, 99
 
   For i = 0 To 99
      Debug.Print Demo(ind(i))
   Next
End Sub