VB 5/6-Tipp 0188: Sortieren mit Quicksort
von ActiveVB
Beschreibung
Quicksort ist im Vergleich zum letzten Tip, wie der Name auch schon vermuten lässt, wesentlich fixer. Es zerlegt das zu sortierende Array in 'halbe' Pakete, und ruft sich rekursiv auf, wo dann wieder ein halbes erzeugt wird usw. solange bis die gewünschte Ordnung hergestellt ist.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: keine | Download: |
'Dieser Quellcode stammt von http://www.activevb.de 'und kann frei verwendet werden. Für eventuelle Schäden 'wird nicht gehaftet. 'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum. 'Ansonsten viel Spaß und Erfolg mit diesem Source! '------------- Anfang Projektdatei Project1.vbp ------------- '--------- Anfang Formular "Form1" alias Form1.frm --------- ' Steuerelement: Schaltfläche "Command2" ' Steuerelement: Listen-Steuerelement "List2" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Listen-Steuerelement "List1" Option Explicit Dim Feld(0 To 500) As String Private Sub Form_Load() Call Shuffle End Sub Private Sub Command1_Click() Dim X As Integer Call QuickSort(LBound(Feld), UBound(Feld)) List2.Clear For X = 0 To UBound(Feld) List2.AddItem Feld(X) Next X End Sub Private Sub Command2_Click() Call Shuffle End Sub Private Sub QuickSort(ByVal LB As Long, ByVal UB As Long) Dim P1 As Long, P2 As Long, Ref As String, TEMP As String P1 = LB P2 = UB Ref = Feld((P1 + P2) / 2) Do Do While (Feld(P1) < Ref) P1 = P1 + 1 Loop Do While (Feld(P2) > Ref) P2 = P2 - 1 Loop If P1 <= P2 Then TEMP = Feld(P1) Feld(P1) = Feld(P2) Feld(P2) = TEMP P1 = P1 + 1 P2 = P2 - 1 End If Loop Until (P1 > P2) If LB < P2 Then Call QuickSort(LB, P2) If P1 < UB Then Call QuickSort(P1, UB) End Sub Private Sub Shuffle() Dim X As Integer, y As Integer, aa As String List1.Clear Randomize For X = 0 To UBound(Feld) aa = "" For y = 0 To 5 aa = aa & Chr$(Rnd * 25 + 65) Next y List1.AddItem aa Feld(X) = aa Next X End Sub '---------- Ende Formular "Form1" alias Form1.frm ---------- '-------------- Ende Projektdatei Project1.vbp --------------
Tipp-Kompatibilität:
Windows/VB-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | |||||||
VB5 | |||||||
VB6 |
Ihre Meinung
Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.
Archivierte Nutzerkommentare
Klicken Sie diesen Text an, wenn Sie die 14 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.
Kommentar von cusdom am 11.09.2008 um 14:40
Für vb.net und etwas Modifiziert (sortiert Integer):
Public Sub QuickSortInteger(ByVal intArr() As Integer, Optional ByVal LB As Integer = 0, Optional ByVal UB As Integer = 0)
Dim P1 As Long
Dim P2 As Long
Dim Ref As Integer
Dim TEMP As Integer
Dim lower As Integer
Dim upper As Integer
If LB = 0 Then
lower = LBound(intArr)
Else
lower = LB
End If
If UB = 0 Then
upper = UBound(intArr)
Else
upper = UB
End If
P1 = lower
P2 = upper
Ref = intArr((P1 + P2) / 2)
Do
Do While (intArr(P1) < Ref)
P1 = P1 + 1
Loop
Do While (intArr(P2) > Ref)
P2 = P2 - 1
Loop
If P1 <= P2 Then
TEMP = intArr(P1)
intArr(P1) = intArr(P2)
intArr(P2) = TEMP
P1 = P1 + 1
P2 = P2 - 1
End If
Loop Until (P1 > P2)
If LB < P2 Then
QuickSortInteger(intArr, lower, P2)
End If
If P1 < UB Then
QuickSortInteger(intArr, P1, upper)
End If
End Sub
Kommentar von Michaela am 31.12.2007 um 00:23
Ich kann der "StrComp"-Methode nur beipflichten, weil sehr schnell, wenn man sie korrekt anwendet.
Kommentar von teddyd am 19.07.2007 um 19:07
fritzfilzlaus: Für absteigende Sortierung einfach bei den beiden Ref-Vergleichen die Größer/Kleiner Zeichen wechseln, also aus
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Do While (Feld(P1) < Ref)
P1 = P1 + 1
Loop
Do While (Feld(P2) > Ref)
P2 = P2 - 1
Loop
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
wird
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Do While (Feld(P1) > Ref)
P1 = P1 + 1
Loop
Do While (Feld(P2) < Ref)
P2 = P2 - 1
Loop
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
:-)
Kommentar von vn am 20.03.2007 um 10:53
Für Ästheten und Erbsenzähler noch ein Verbesserungsvorschlag
Private Sub QuickSort(ByRef Feld() As Long, ByVal LB As Long, ByVal UB As Long)
"Feld" kann auch als Variable in den rekursiven Aufruf mit aufgenommen werden.
Kommentar von fritzfilzlaus am 11.02.2007 um 12:23
Hallo, wie muss der Code verändert werden, damit er das Array absteigend (Z, Y, ...) sortiert? :-)
Kommentar von Martin am 12.04.2005 um 16:23
Der Quicksort funktioniert prima. Habe aber noch einen Verbesserungsvorschlag. Die Vergleiche:
Do While (Feld(P1) < Ref)
und
Do While (Feld(P2) > Ref)
beachten die Besonderheiten bei nationalen Sonderzeichen nicht. So tauchen z. B. Ä's, Ö's und Ü's in der Liste hinten auf. Man kann dies aber recht einfach beheben:
Do While StrComp(Feld(P1), Ref, vbTextCompare) = -1
und
Do While StrComp(Feld(P2), Ref, vbTextCompare) = 1
Kommentar von viba6 am 03.09.2003 um 17:20
Einfach klasse der Code. Hab ihn bei einer klassischen Versetzungschiffre eingesetzt um den Schlüssel zu ordnen - sehr schnell und gut nachvollziehbar!
viba
Kommentar von Phantomix am 03.06.2003 um 11:05
Quicksort rulez! Hab das ding in informatik auf nem 286er gesehn wie er in 1 Sekunde einen 32767 integer array sortierte!!!
Kommentar von Michael am 16.04.2002 um 15:33
Ich hätte da noch eine grundlegende Frage :)
Wie sieht das ganze bei String Arrays mit über 32000 Zeilen aus ?
Kommentar von Herfried Wagner am 25.03.2002 um 20:10
Schau mal in http://www.ActiveVB-Archiv.de/VZ-Hirf/sortandsearch.zip in das Sorting-Beispiel.
Grüsse,
Hirf
Kommentar von Uwe am 01.10.2001 um 15:03
Klasse Code
Ich verwende ihn in MindManager mit SaxBasic und der Code funktioniert einwandfrei und sauschnell.
Uwe
Kommentar von peter straschok am 25.05.2001 um 14:37
Der Tipp ist genial und funktioniert fuer jede feldgroese, besonders auch bei dynamischen felder.
Zu Pete: Lieber Pete, die 500 ist ein reiner beispiel wert. man hat sowieso meistens mit dynamischen feldern zu tue, die mir redim preserve... entsprechend angepasst werden. zum Author: einfach nur genial.
Kommentar von Tom Kericht am 30.01.2001 um 05:43
Hi Pete, na das gleiche wie bei einer geraden Zahl. Das ist vollkommen irrelevant, da es sich wie der Variablennamen schon nahe legt, lediglich um einen Referenzewert handelt. Ergäbe sich eine ungerade Zahl bei der Teilung, ist der Referenzwert schlimmstenfalls der kleinste Teil der Zerlegung und würde mit sich selbst verglichen, was wiederum die Sortierfolge nicht stört.
Kommentar von pete am 30.01.2001 um 04:31
der tip ist ja ganz nett, aber was passiert bei einer feldgrösse, von 501, wenn also (p1 + p2) /2 keine ganze zahl ist? bzw. wie kann ich das problem umgehen?
thx