Rubrik: Variablen/Strings · Algorithmen/Mathematik | VB-Versionen: VB5, VB6 | 09.02.04 |
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.421 |
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!