Rubrik: Variablen/Strings · Algorithmen/Mathematik | VB-Versionen: VB6 | 29.01.04 |
QuickSort optimiert QuickSort gehört zu einem der schnellsten Sortier-Algorithmen. Hier erfahren Sie, wie man den Algorithmus zusätzlich noch optimieren kann. | ||
Autor: Dieter Otter | Bewertung: | Views: 20.413 |
www.tools4vb.de | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | Beispielprojekt auf CD |
QuickSort gehört zu einem der schnellsten Sortier-Algorithmen. Den dazugehörigen VB-Code haben wir Ihnen ja schon vor einiger Zeit vorgestellt:
QuickSort in VB
Damit der QuickSort-Algorithmus universell eingesetzt werden konnte, wurde das zu sortierende Array als Variant-Parameter deklariert. Durch gezielte Datentyp-Deklaration lässt sich das Sortierverfahren aber erheblich steigern. Bei großen Datenmengen sollte man deshalb mehrere QuickSort-Varianten verwenden, z.B. QuickSort_s für String-Arrays, QuickSort_l für LongInteger-Arrays usw.
Handelt es sich beim zu sortierenden Array um ein String-Array lässt sich die Perfomance nochmals steigern, wenn man das Vertauschen zweier Array-Inhalte durch eine API-Funktion erledigt.
Nachfolgend der optimierte QuickSort-Algorithmus für String-Arrays.
' Benötigte API-Deklaration Private Declare Sub CopyMemoryPtr Lib "kernel32" _ Alias "RtlMoveMemory" ( _ ByVal DestPtr As Long, _ ByVal SourcePtr As Long, _ ByVal Bytes As Long)
Public Sub QuickSort_s(ByRef vSort() As String, _ Optional ByVal lngStart As Variant, _ Optional ByVal lngEnd As Variant) ' Wird die Bereichsgrenze nicht angegeben, ' so wird das gesamte Array sortiert If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim i As Long Dim j As Long Dim X As String Dim n As Long Dim nPtr As Long On Error Resume Next i = lngStart: j = lngEnd n = ((lngStart + lngEnd) \ 2) X = vSort(n) ' Array aufteilen Do Do While (StrComp(vSort(i), X, vbTextCompare) = -1): i = i + 1: Loop Do While (StrComp(vSort(j), X, vbTextCompare) = 1): j = j - 1: Loop If (i <= j) Then ' Wertepaare miteinander tauschen nPtr = StrPtr(vSort(i)) CopyMemoryPtr VarPtr(vSort(i)), VarPtr(vSort(j)), Len(nPtr) CopyMemoryPtr VarPtr(vSort(j)), VarPtr(nPtr), Len(nPtr) i = i + 1: j = j - 1 End If Loop Until (i > j) ' Rekursion (Funktion ruft sich selbst auf) If (lngStart < j) Then QuickSort_s vSort, lngStart, j If (i < lngEnd) Then QuickSort_s vSort, i, lngEnd On Error GoTo 0 End Sub
Im Gegensatz zum Standard-QuickSort-Algorithmus wird die Groß-/Kleinschreibung hier korrekt berücksichtigt, d.h. Strings mit kleinen Anfangs-Buchstaben reihen sich korrekt ein.
Ein kleiner Geschwindigkeitstest
Erstellen Sie ein neues Projekt, platzieren auf die Form zwei Label-Controls, zwei ListBox-Controls und zwei CommandButtons. Fügen Sie jetzt den "alten" QuickSort-Algorithmus ein, sowie obigen neuen Code. Beim Klick auf den 1. CommandButton wird das im Form_Load zufällig erzeugte Array mit 50000 Elementen sortiert und die Zeit gemessen. Das Ergebnis wird dann in List1 angezeigt. Jetzt klicken Sie auf den 2. CommandButton. Das Array wird wieder sortiert - diesmal mit der optimierten Variante.
Option Explicit Private Const nCount = 49999 Dim sArray() As String
Private Sub Form_Load() ' Array mit 50000 Elementen Dim i As Long Dim n As Long Dim u As Long Dim b As Long ReDim sArray(nCount) Randomize -Timer For i = 0 To nCount ' zufällige Wortlänge n = Int(20 * Rnd + 5) For u = 1 To n ' zufällige Buchstabenkombination b = Int(2 * Rnd + 1) If b = 1 Then sArray(i) = sArray(i) & Chr$(64 + Int(26 * Rnd + 1)) Else sArray(i) = sArray(i) & Chr$(96 + Int(26 * Rnd + 1)) End If Next u Next i End Sub
Private Sub Command1_Click() Dim nStart As Single Dim sTemp() As String Dim i As Long Screen.MousePointer = vbHourglass ' Temporäres Array ReDim sTemp(nCount) For i = 0 To nCount sTemp(i) = sArray(i) Next i ' Zeit nehmen nStart = Timer ' Array sortieren: "altes Verfahren" QuickSort sTemp, 0, nCount ' Benötigte Zeit Label1.Caption = "Zeit: " & CStr(Timer - nStart) & " Sek." ' Array in Liste ausgeben List1.Clear List1.Visible = False DoEvents For i = 0 To nCount List1.AddItem sTemp(i) Next i List1.Visible = True Screen.MousePointer = vbNormal End Sub
Private Sub Command2_Click() Dim nStart As Single Dim sTemp() As String Dim i As Long Screen.MousePointer = vbHourglass ' Temporäres Array ReDim sTemp(nCount) For i = 0 To nCount sTemp(i) = sArray(i) Next i ' Zeit nehmen nStart = Timer ' Array sortieren: optimierte Variante QuickSort_s sTemp, 0, nCount ' Benötigte Zeit Label2.Caption = "Zeit: " & CStr(Timer - nStart) & " Sek." ' Array in Liste ausgeben List2.Clear List2.Visible = False DoEvents For i = 0 To nCount List2.AddItem sTemp(i) Next i List2.Visible = True Screen.MousePointer = vbNormal End Sub
Das Ergebnis:
Die neue optimierte Variante sortiert das String-Array nahezu doppelt so schnell!