VB 5/6-Tipp 0758: Sortieren mit MergeSort
von Dario
Beschreibung
MergeSort ist ein anderer, weit verbreiteter Sortieralgorithmus, der es u.U. durchaus mit QuickSort aufnehmen kann. Wie dieser arbeitet MergeSort nach dem Divide & Conquer-Prinzip. Er teilt die Daten in 2 Hälften, die er rekursiv mit sich selbst sortiert. Die einzelnen Teillisten werden miteinander verschmolzen, bis schließlich alles sortiert ist.
Vorteil ist, dass, je nach Implementierung der Merge-Funktion, der Algorithmus leicht stabil zu implementieren ist.
Dabei läuft das Verfahren konstant in [latex]\mathcal{O}(n log n)[/latex], benötigt allerdings, obwohl des letztendlich in-place verschmilzt, [latex]\mathcal{O}(n)[/latex] zusätzlichen Speicherplatz.
Kernfunktion dieses Tipps ist die Merge-Prozedur, die ein Array, in dem 2 Hälften bereits sortiert sind, zu einem sortierten Array verschmilzt.
Dazu ist noch ein QuickSort implementiert und für beide werden verlangsamte Sortieranimation gezeigt.
Schwierigkeitsgrad: | Verwendete API-Aufrufe: | 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 Projekt1.vbp ------------- '------ Anfang Formular "frmMergeSort" alias Form1.frm ------ ' Steuerelement: Optionsfeld-Steuerelement "Option2" ' Steuerelement: Optionsfeld-Steuerelement "Option1" ' Steuerelement: Listen-Steuerelement "List2" ' Steuerelement: Listen-Steuerelement "List1" ' Steuerelement: Schaltfläche "Command1" ' Steuerelement: Bildfeld-Steuerelement "Picture1" Option Explicit Const Num As Long = 200, Max As Long = 100 Private Declare Sub Sleep Lib "kernel32" (ByVal X As Long) Private Sub Command1_Click() Dim MyArray(Num) As Long, i As Long Command1.Enabled = False Option1.Enabled = False Option2.Enabled = False Call Randomize Call List1.Clear Call List2.Clear For i = 0 To Num MyArray(i) = Int(Rnd * (Max + 1)) Call List1.AddItem(MyArray(i)) Next i If Option1.Value = True Then Call MergeSort.MergeSort(MyArray) Else Call QuickSort.QuickSort(MyArray) End If For i = 0 To Num Call List2.AddItem(MyArray(i)) Next i Command1.Enabled = True Option1.Enabled = True Option2.Enabled = True End Sub Private Sub Form_Load() Picture1.AutoRedraw = True Picture1.Scale (0, Max)-(Num, 0) Picture1.BackColor = vbWhite Picture1.DrawWidth = 2 End Sub Public Sub Visualize(ByRef Data() As Long, Sorted As Long) Dim i As Long Call Picture1.Cls For i = 0 To Num Picture1.PSet (i, Data(i)), IIf(i > Sorted, vbRed, vbBlack) Next i Call [DoEvents] Call Sleep(15) End Sub Private Sub Option1_Click() Caption = IIf(Option1.Value = True, "MergeSort", "QuickSort") End Sub Private Sub Option2_Click() Call Option1_Click End Sub '------- Ende Formular "frmMergeSort" alias Form1.frm ------- '------- Anfang Modul "MergeSort" alias MergeSort.bas ------- Option Explicit ' Verschmilzt [Left; Middle] mit (Middle; Right] in [Left; Right] Public Sub InplaceMerge(ByVal Left As Long, ByVal Middle As Long, ByVal Right As Long, ByRef Data() As Long) Dim Temp() As Long Dim i As Long Dim j As Long Dim dst As Long ' Temporäres Array dimensionieren ReDim Temp(Middle - Left) As Long ' [Left; Middle] in das temporäre Array kopieren j = 0 For i = Left To Middle Temp(j) = Data(i) j = j + 1 Next i ' Sortiert in das Originalarray zurückkopieren j = 0 dst = Left Do While i <= Right And j <= UBound(Temp) If Data(i) < Temp(j) Then Data(dst) = Data(i) i = i + 1 Else Data(dst) = Temp(j) j = j + 1 End If dst = dst + 1 Loop ' Ggf. das temporäre Array ins Original schreiben, wenn noch etwas übrig ist Do While j <= UBound(Temp) Data(dst) = Temp(j) dst = dst + 1 j = j + 1 Loop End Sub ' Rekursiver Aufruf von MergeSort Public Sub MergeSortRec(ByVal Left As Long, ByVal Right As Long, ByRef Data() As Long) Dim Middle As Long Middle = (Left + Right) \ 2 If Left < Right Then Call MergeSortRec(Left, Middle, Data) Call MergeSortRec(Middle + 1, Right, Data) Call InplaceMerge(Left, Middle, Right, Data) Call frmMergeSort.Visualize(Data, Right) End If End Sub ' Array-Wrapper-Aufruf für MergeSortRec Public Sub MergeSort(ByRef Data() As Long) Call MergeSortRec(0, UBound(Data), Data) End Sub '-------- Ende Modul "MergeSort" alias MergeSort.bas -------- '------- Anfang Modul "QuickSort" alias QuickSort.bas ------- Option Explicit ' Rekursives QuickSort mit erstem Element als Pivotelement Public Sub QuickSortRec(ByVal Left As Long, ByVal Right As Long, ByRef Data() As Long) Dim Pivot As Long, r As Long, l As Long, t As Long If Left >= Right Then Exit Sub Pivot = Data(Left) r = Right l = Left Do Do While Data(l) < Pivot l = l + 1 Loop Do While Pivot < Data(r) r = r - 1 Loop If l <= r Then t = Data(l) Data(l) = Data(r) Data(r) = t l = l + 1 r = r - 1 End If Loop Until l > r Call frmMergeSort.Visualize(Data, Right) Call QuickSortRec(Left, r, Data) Call QuickSortRec(l, Right, Data) End Sub ' Array-Wrapper-Aufruf für QuickSortRec Public Sub QuickSort(ByRef Data() As Long) Call QuickSortRec(0, UBound(Data), Data) End Sub '-------- Ende Modul "QuickSort" alias QuickSort.bas -------- '-------------- Ende Projektdatei Projekt1.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.