Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0758: Sortieren mit MergeSort

 von 

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:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

Sleep

Download:

Download des Beispielprojektes [3.38 KB]

'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-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

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.