QuickSort optimiert II QuickSort gehört zu einem der schnellsten Sortier-Algorithmen. Hier erfahren Sie, wie man den Algorithmus zusätzlich noch optimieren kann.
Autor:   LonelySuicide666	Bewertung:	Views:  23.422
www.vbapihelpline.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Vor kurzem erst haben wir Ihnen gezeigt, wie sich der von Haus aus schon sehr schnelle QuickSort-Sortieralgorithmus in Bezug auf String-Arrays nochmals optimieren lässt:
 QuickSort optimiert

Heute präsentieren wir Ihnen den absoluten Hammer. Der schnellste Quicksort-Algorithmus, den es je gab Durch gezielte LowLevel Pointer-Programmierung lässt sich die Perfoamnce des Algorithmus nochmals um knapp 100% steigern!

Option Explicit
 
' benötigte API-Deklarationen
Private Declare Function lstrcmp Lib "kernel32" _
  Alias "lstrcmpiW" ( _
  ByVal lpString1 As Long, _
  ByVal lpString2 As Long) As Long
 
Private Declare Sub CopyMemory Lib "kernel32" _
  Alias "RtlMoveMemory" ( _
  Dest As Any, _
  Source As Any, _
  ByVal Bytes As Long)
 
Private Declare Function VarPtrArray Lib "msvbvm60.dll" _
  Alias "VarPtr" ( _
  Ptr() As Any) As Long

' Quicksort für String-Arrays 
' mit LowLevel Pointer-Programmierung
Public Sub QuickSort_Str(ByRef StrSort() As String, _
  Optional lngStart As Variant, _
  Optional lngEnd As Variant)
 
  Dim TmpStrPtr(0) As Long
  Dim PtrSAD As Long
  Dim PtrBackup As Long
  Dim Range As Long
  Dim LB As Long
  Dim UB As Long
 
  ' Array gefüllt ?
  If (Not (Not StrSort)) = 0 Then Exit Sub
  LB = LBound(StrSort)
  UB = UBound(StrSort)
 
  ' Alle Werte richtig gesetzt ?
  If IsMissing(lngStart) Then lngStart = LB
  If lngStart < LB Or lngStart > UB Then Exit Sub
  If IsMissing(lngEnd) Then lngEnd = UB
  If lngEnd <= lngStart Or lngEnd > UB Then Exit Sub
 
  ' Werte neu berechnen
  Range = LB + UB + 1
  lngStart = Abs(LB + lngStart)
  lngEnd = Abs(LB + lngEnd)
 
  ' String-Array auf ein Long-Array mappen
  PtrBackup = VarPtr(TmpStrPtr(0))
  CopyMemory ByVal VarPtr(PtrSAD), ByVal VarPtrArray(TmpStrPtr), 4
  CopyMemory ByVal PtrSAD + 12, VarPtr(StrSort(LB)), 4
  CopyMemory ByVal PtrSAD + 16, Range, 4
 
  ' Sortieren des Long-Arrays, gefüllt mit String-Pointern
  SortEx TmpStrPtr, CLng(lngStart), CLng(lngEnd)
 
  ' Long-Array wiederherstellen
  CopyMemory ByVal PtrSAD + 12, PtrBackup, 4
  CopyMemory ByVal PtrSAD + 16, CLng(1), 4
End Sub

' Long-Array mit String-Pointern sortieren
Private Sub SortEx(ByRef ptrSort() As Long, _
  StartSort As Long, EndSort As Long)
 
  Dim TmpPtr As Long
  Dim TmpPtr2 As Long
  Dim I As Long
  Dim J As Long
 
  TmpPtr = ptrSort(((StartSort + EndSort) \ 2))
  I = StartSort
  J = EndSort
  Do
    Do While (lstrcmp(ptrSort(I), TmpPtr) < 0): I = I + 1: Loop
    Do While (lstrcmp(ptrSort(J), TmpPtr) > 0): J = J - 1: Loop
 
    If (I <= J) Then
      TmpPtr2 = ptrSort(I)
      ptrSort(I) = ptrSort(J)
      ptrSort(J) = TmpPtr2
 
      I = I + 1: J = J - 1
    End If
  Loop Until (I > J)
 
  ' Rekursion (Funktion ruft sich selbst auf)
  If (StartSort < J) Then SortEx ptrSort, StartSort, J
  If (I < EndSort) Then SortEx ptrSort, I, EndSort
End Sub

Machen wir einen Test
Wir erstellen ein Array mit 50.000 Elementen - gefüllt mit zufällig zusammengestellten Strings der Länge 4 bis 20. Der Sortiervorgang des Arrays mit dem Code aus dem Tipp  QuickSort optimiert benötigt auf unserem Testrechner 390 Millisekunden. Danach sortieren wir das gleiche Array mit dem neuen QuickSort-Algorithmus und das Ergebnis kann sich sehen lassen: QuickSort_Str benötigt für den Sortiervorgang gerade einmal 210 Millisekunden - arbeitet also annähernd doppelt so schnell!
 

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.