Tipp-Upload: VB.NET 0345: IntroSort

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Algorithmen

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
introsort, quicksort, insertionsort, heapsort, sort, sortieren

Der Vorschlag wurde erstellt am: 12.02.2009 15:07.
Die letzte Aktualisierung erfolgte am 16.02.2009 16:56.

Zurück zur Übersicht

Beschreibung  

QuickSort ist verdientermaßen einer der meist eingesetzten Sortieralgorithmen, ist er doch von der Performance unschlagbar.
Doch er hat auch eine Schattenseite: Bei ungünstigen Daten kann seine Effizienz ins Bodenlose fallen, da alles von der sinnvollen Wahl eines sog. Pivotelements abhängt. Durch Techniken wie die 3-Median-Variante (die auch bei den .NET-Sortierfunktionen eingesetzt wird), wird diese Gefahr gemindert, jedoch nicht ganz gebannt. Auch treten immer kleine Datenmengen auf, auf denen QuickSort ungünstig arbeitet.

IntroSort (Introspective Sort) ist ein Hybridalgorithmus, der mehrere Sortierverfahren kombiniert und laufend prüft, mit welchem der weitere Sortiervorgang am sinnvollsten fortzusetzen ist. In diesem Beispiel vereint er die Effizienz von QuickSort mit der vorhersagbaren Leistung von Heap- und Insertionsort, auf die er in für QuickSort ungünstigen Fällen zurückgreift. Entschieden wird dabei anhand der Rekursionstiefe von QuickSort.
IntroSort gilt als der schnellste (nicht stabile) Sortieralgorithmus.

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [11,35 KB]

' Dieser Source 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!
'
' Beachten Sie, das vom Designer generierter Code hier ausgeblendet wird.
' In den Zip-Dateien ist er jedoch zu finden.

' ------------ Anfang Projektgruppe IntroSort.sln ------------
' ----------- Anfang Projektdatei IntroSort.vbproj -----------
' ---------------- Anfang Datei IntroSort.vb  ----------------
Module IntroSort

    Sub IntroSort(Of T)(ByVal Data As T(), ByVal Left As Integer, ByVal Right As Integer, _
        ByVal Comparison As Comparison(Of T))

        Call IntroSort(Data, Left, Right, CInt(2 * Math.Log(Right - Left, 2)), Comparison)
        Call InsertionSort(Data, Left, Right, Comparison)

    End Sub

    Private Sub IntroSort(Of T)(ByVal Data As T(), ByVal Left As Integer, ByVal Right As _
        Integer, ByVal Depth As Integer, ByVal Comparison As Comparison(Of T))

        If (Right - Left) <= 8 Then Return

        If Depth >= 0 Then

            Call QuickSort(Data, Left, Right, Depth, Comparison)

        Else

            Call HeapSort(Data, Left, Right, Comparison)

        End If

    End Sub

    Private Sub InsertionSort(Of T)(ByVal Data As T(), ByVal Left As Integer, ByVal Right As _
        Integer, ByVal Comparison As Comparison(Of T))

        For i = Left To Right

            Dim j = i
            Dim tmp = Data(i)

            While j > Left AndAlso Comparison(Data(j - 1), tmp) > 0
                Data(j) = Data(j - 1)
                j -= 1

            End While

            Data(j) = tmp
        Next

    End Sub

    Private Sub QuickSort(Of T)(ByVal Data As T(), ByVal Left As Integer, ByVal Right As _
        Integer, ByVal Depth As Integer, ByVal Comparison As Comparison(Of T))

        Dim i = Left
        Dim j = Right

        Dim a = Data(Left), b = Data(Right), c = Data((Left + Right) \ 2)

        If Comparison(a, b) > 0 Then Call Swap(a, b)
        If Comparison(a, c) > 0 Then Call Swap(a, c)
        If Comparison(b, c) > 0 Then Call Swap(b, c)

        Dim Pivot = b

        Do

            While Comparison(Data(i), Pivot) < 0
                i += 1

            End While

            While Comparison(Data(j), Pivot) > 0
                j -= 1

            End While

            If i <= j Then

                Call Swap(Data(i), Data(j))

                i += 1
                j -= 1
            End If

        Loop Until i > j

        Call IntroSort(Data, Left, j, Depth - 1, Comparison)
        Call IntroSort(Data, i, Right, Depth - 1, Comparison)

    End Sub

    Private Sub HeapSort(Of T)(ByVal Data As T(), ByVal Left As Integer, ByVal Right As _
        Integer, ByVal Comparsion As Comparison(Of T))

        Dim Middle = (Right + Left) \ 2

        For i = Middle - 1 To Left Step -1

            Call DownHeap(Data, i, Left, Right, Comparsion)

        Next

        For n = Right To Left + 1 Step -1

            Call Swap(Data(Left), Data(n))
            Call DownHeap(Data, Left, Left, n - 1, Comparsion)

        Next

    End Sub

    Private Sub DownHeap(Of T)(ByVal Data As T(), ByVal Current As Integer, ByVal Begin As _
        Integer, ByVal [End] As Integer, ByVal Comparison As Comparison(Of T))

        Do

            Dim Left = Begin + 2 * (Current - Begin) + 1, Right = Begin + 2 * (Current - _
                Begin) + 2, Max = Current

            If (Left <= [End]) AndAlso Comparison(Data(Left), Data(Max)) > 0 Then Max = Left

            If (Right <= [End]) AndAlso Comparison(Data(Right), Data(Max)) > 0 Then Max = Right

            If (Max <> Current) Then

                Call Swap(Data(Max), Data(Current))

                Current = Max

            Else

                Exit Do

            End If

        Loop

    End Sub

    Private Sub Swap(Of T)(ByRef a As T, ByRef b As T)

        Dim Tmp = a

        a = b
        b = Tmp

    End Sub

End Module

' ----------------- Ende Datei IntroSort.vb  -----------------
' ----------------- Anfang Datei Module1.vb  -----------------
Option Strict On

Module Module1

    Sub Main()

        Dim Rand As New Random

        Dim Data = (From i In Enumerable.Range(1, 5000000) Select Rand.NextDouble()).ToArray()

        ' Array vorsortieren?
        Array.Sort(Data, Function(a, b) b.CompareTo(a))

        ' Zeiten für Array.Sort stoppen
        Dim Watch = New Diagnostics.Stopwatch

        Call Watch.Start()
        Call Array.Sort(DirectCast(Data.Clone(), Double()), Function(a, b) b.CompareTo(a))
        Call Watch.Stop()
        Call Console.WriteLine("Array.Sort: {0}s", Watch.Elapsed.TotalSeconds)

        ' Zeiten für IntroSort stoppen
        Call Watch.Reset()
        Call Watch.Start()

        Call IntroSort.IntroSort(DirectCast(Data.Clone(), Double()), 0, Data.Length - 1, _
            Function(a, b) b.CompareTo(a))

        Call Watch.Stop()

        Console.WriteLine("IntroSort: {0}s", Watch.Elapsed.TotalSeconds)

        Console.ReadKey()

    End Sub

End Module

' ------------------ Ende Datei Module1.vb  ------------------
' ------------ Ende Projektdatei IntroSort.vbproj ------------
' ------------- Ende Projektgruppe IntroSort.sln -------------

	

Diskussion  

Diese Funktion ermöglicht es, Fragen, die die Veröffentlichung des Tipps betreffen, zu klären, oder Anregungen und Verbesserungsvorschläge einzubringen. Nach der Veröffentlichung des Tipps werden diese Beiträge nicht weiter verlinkt. Allgemeine Fragen zum Inhalt sollten daher hier nicht geklärt werden.
Folgende Diskussionen existieren bereits

Um eine Diskussion eröffnen zu können, müssen sie angemeldet sein.