Tipp-Upload: VB.NET 0306: Sortieren mit ShellSort

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Algorithmen
• Mathematik

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
insertionsort, shellsort, shell, sort, sortieren, optimierung

Der Vorschlag wurde erstellt am: 23.08.2008 15:17.
Die letzte Aktualisierung erfolgte am 23.08.2008 15:17.

Zurück zur Übersicht

Beschreibung  

ShellSort (nach Donald L. Shell) ist ein sehr schnelles Sortierverfahren und basiert auf der Optimierung von InsertionSort. Bei diesem werden die Elemente vor dem aktuellen so lange schrittweise nach rechts verschoben, bis das aktuelle Element in die entstandene Lücke eingefügt werden kann, ohne die Ordnung zu verletzen. In einer bereits sortierten Folge ist dieses Verfahren extrem schnell, ist das aber nicht der Fall, muss ein Element langsam über weite Strecken verschoben werden. ShellSort sortiert das das Array schrittweise vor, indem es Elemente zunächst überspringt. ´Im nächsten Schritt werden diese Lücken immer kleiner und am Ende hat man ein InsertionSort, das aber, weil das Array vorsortiert ist, gute Laufzeiten erzielt.
Für die Performance entscheidend ist dabei, wie die Schrittweiten bei den Lücken gewählt werden. Diese Folge nennt sich Gap-Sequenz oder h-Folge.

In diesem Tipp kann man ein wenig mit ShellSort und verschiedenen h-Folgen experimentieren. Nur 2 Zeilen Code trennen Shell- von InsertionSort, aber die Wirkung ist enorm. Weiteres auch unter sortieralgorithmen.de

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [13,99 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 ShellSort.sln ------------
' ----------- Anfang Projektdatei ShellSort.vbproj -----------
' ------------------ Anfang Datei Form1.vb  ------------------
Public Class Form1

    ' Größtenteils uninteressant - Hauptsächlich Animation
    ' Der Kern-Quellcode befindet sich in den anderen Quelldateien

    Private Data As Integer()

    Private ReadOnly Property DataSize() As Integer
        Get
            Return numDataSize.Value

        End Get

    End Property

    Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As _
        System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint

        Dim ScalingX = PictureBox1.Width / DataSize
        Dim ScalingY = PictureBox1.Height / DataSize

        If Data Is Nothing Then Return

        For x = 0 To DataSize - 1

            e.Graphics.FillRectangle(Brushes.Red, New Rectangle(x * ScalingX, Data(x) * _
                ScalingY, 2, 2))

        Next

    End Sub

    ' Nochmal ShellSort - zum Visualisieren
    Private Sub ShellSortVisualize(Of T)(ByVal Data() As T, ByVal Comp As Comparison(Of T), _
        ByVal GapFunc As GapFunction)

        Dim Tmp As T
        Dim Len = Data.Length
        Dim Pos As Integer
        Dim Cols = GapFunc(Len)
        Dim Count = 0

        For Each h In Cols
            Text = "ShellSort [ h = " & h.ToString & " ]"

            For i = h To Len - 1

                Tmp = Data(i)
                Pos = i

                Do Until (Pos < h) OrElse (Comp(Data(Pos - h), Tmp) > 0)
                    Data(Pos) = Data(Pos - h)
                    Pos -= h

                    If Count Mod 10 = 0 Then PictureBox1.Refresh()
                    Count += 1
                Loop

                Data(Pos) = Tmp
            Next
        Next

        PictureBox1.Refresh()

    End Sub

    Private Sub numDataSize_ValueChanged(ByVal sender As System.Object, ByVal e As _
        System.EventArgs) Handles numDataSize.ValueChanged

        ShuffleData()

    End Sub

    Sub ShuffleData()

        Static Rnd As New Random

        Data = (From x In Enumerable.Range(1, DataSize) Select Rnd.Next(DataSize)).ToArray

        PictureBox1.Invalidate()

    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles MyBase.Load

        cboGap.DataSource = (From x In GapSequences Select x.Name).ToList

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles Button1.Click

        Dim [Function] = GapSequences(cboGap.SelectedIndex).Func
        Dim Comparison As Comparison(Of Integer)

        If chkAscending.Checked Then Comparison = Function(a, b) a - b Else Comparison = _
            Function(a, b) b - a

        For Each ctl As Control In GroupBox2.Controls
            ctl.Enabled = False
        Next

        ShellSortVisualize(Data, Comparison, [Function])

        For Each ctl As Control In GroupBox2.Controls
            ctl.Enabled = True
        Next

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles Button2.Click

        ShuffleData()

    End Sub

    Private Sub cboGap_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As _
        System.EventArgs) Handles cboGap.SelectedIndexChanged

        Dim Gaps = GapSequences(cboGap.SelectedIndex).Func(100)
        Dim Str As String = ""

        For i = 0 To Gaps.Count - 2
            Str &= Gaps(i).ToString & ", "
        Next

        lblH.Text = "h = { " & Str & Gaps(Gaps.Count - 1).ToString() & " }"

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) _
        Handles Button3.Click

        Dim [Function] = GapSequences(cboGap.SelectedIndex).Func
        Dim Comparison As Comparison(Of Integer)

        If chkAscending.Checked Then Comparison = Function(a, b) a - b Else Comparison = _
            Function(a, b) b - a

        Dim Watch = New Stopwatch

        Watch.Start()
        ShellSort(Data, Comparison, [Function])
        Watch.Stop()

        MessageBox.Show(String.Format("Zeit für {0} Elemente : {1} ms", DataSize, _
            Watch.Elapsed.TotalMilliseconds.ToString), "Ergebnis", _
            MessageBoxButtons.OKCancel, MessageBoxIcon.Information)

        ShuffleData()
        PictureBox1.Invalidate()

    End Sub

End Class

' ------------------- Ende Datei Form1.vb  -------------------
' --------------- Anfang Datei GapSequences.vb ---------------
Module MyGapSequences

    ' Ein paar Gap-Sequenzen zur Verfügung stellen
    Public GapSequences As GapSequence() = {New GapSequence("Shell (Original)", Function(i) _
        MakeSequence(i, Function(x) 2 * x)), New GapSequence("Sedgewick", AddressOf _
        SedgewickSequence), New GapSequence("Papernov-Stasevich", Function(i) MakeSequence(i, _
        Function(x) 2 * x + 1)), New GapSequence("Knuth", Function(i) MakeSequence(i, _
        Function(x) 3 * x + 1)), New GapSequence("11/5 x + 1", Function(i) MakeSequence(i, _
        Function(x) x * 11 / 5 + 1)), New GapSequence("InsertionSort", AddressOf _
        InsertionSortSequence)}

    Public Delegate Function GapFunction(ByVal Size As Integer) As Integer()

    Public Function MakeSequence(ByVal Size As Integer, ByVal Operation As Func(Of Double, _
        Double)) As Integer()

        Dim x = 1

        Dim Values = New List(Of Integer)()

        Do
            Values.Add(x)
            x = CInt(Operation(CDbl(x)))
        Loop Until x > Size

        Return DirectCast(Values, IEnumerable(Of Integer)).Reverse().ToArray()

    End Function

    Structure GapSequence

        Public Name As String
        Public Func As GapFunction

        Public Sub New(ByVal Name As String, ByVal Func As GapFunction)

            Me.Name = Name
            Me.Func = Func

        End Sub

    End Structure

    Public Function InsertionSortSequence(ByVal Size As Integer) As Integer()

        Return New Integer() {1}

    End Function

    Public Function SedgewickSequence(ByVal Size As Integer) As Integer()

        Dim p = 1, x = 1

        Dim Values = New List(Of Integer)()

        Do
            Values.Add(x)
            x = 4 ^ p + 3 * 2 ^ (p - 1) + 1
            p = p + 1
        Loop Until x > Size

        Return DirectCast(Values, IEnumerable(Of Integer)).Reverse().ToArray()

    End Function

End Module

' ---------------- Ende Datei GapSequences.vb ----------------
' ---------------- Anfang Datei ShellSort.vb  ----------------
Module ShellSorter

    ' Das ist alles!

    Public Sub ShellSort(Of T)(ByVal Data() As T, ByVal Comp As Comparison(Of T), ByVal _
        GapFunc As GapFunction)

        Dim Tmp As T ' Temporäres Element
        Dim Len = Data.Length ' Länge des Arrays
        Dim Pos As Integer ' Aktuelle Einfügeposition
        Dim Cols = GapFunc(Len) ' Die Gap-Sequenz evaluieren

        ' Alle Gaps durchlaufen
        For Each h In Cols

            ' Alle Elemente von h ab durchlaufen
            For i = h To Len - 1

                Tmp = Data(i)
                Pos = i

                ' Einfügeposition suchen und so lange die zu großen Elemente nach rechts verschieben
                Do Until (Pos < h) OrElse (Comp(Data(Pos - h), Tmp) > 0)
                    Data(Pos) = Data(Pos - h)
                    Pos -= h
                Loop

                ' Einfügen
                Data(Pos) = Tmp
            Next
        Next

    End Sub

End Module

' ----------------- Ende Datei ShellSort.vb  -----------------
' ------------ Ende Projektdatei ShellSort.vbproj ------------
' ------------- Ende Projektgruppe ShellSort.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.