Die Community zu .NET und Classic VB.

Startseite / Tipps / VB.NET-Tipp 0080: Suchen und Sortieren mit dem .NET-Framework

VB.NET-Tipp 0080: Suchen und Sortieren mit dem .NET-Framework

 von Spatzenkanonier

Schwierigkeitsgrad:

Framework-Version(en): .NET Framework 2.0, .NET Framework 3.0, .NET Framework 3.5

.NET-Version(en): Visual Basic 2005, Visual Basic 2008

Download: Download des Beispielprojektes [14,18 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!

' Projektversion:   Visual Studio 2005
' Option Strict:    An
'
' Referenzen: 
'  - System
'  - System.Data
'  - System.Deployment
'  - System.Drawing
'  - System.Web.Services
'  - System.Windows.Forms
'  - System.Xml
'
' Imports: 
'  - Microsoft.VisualBasic
'  - Microsoft.VisualBasic.ControlChars
'  - System
'  - System.Collections
'  - System.Collections.Generic
'  - System.Data
'  - System.Drawing
'  - System.Diagnostics
'  - System.Windows.Forms
'

' ##############################################################################
' ############################ frmSortAndSearch.vb #############################
' ##############################################################################
Public Class frmSortAndSearch
    Private _Data As New List(Of String)
    Private _Comparer As New NumericStringComparer

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

        ' Zum Aufzeigen der Eigenheiten lexikalischer / numerischer Sortierung 
        ' ist der Ziffernbereich von 4-8 unwesentlich
        Dim Numbs As Integer() = New Integer() {1, 2, 3, 9, 10, 11}
        For Each I As Integer In Numbs
            _Data.Add(String.Concat(I, " Text"))
            For Each II As Integer In Numbs
                _Data.Add(String.Concat(I, ".", II, " Text"))
                For Each III As Integer In Numbs
                    _Data.Add(String.Concat(I, ".", II, ".", III, " Text"))
                Next
            Next
        Next
        Me.btUnSort.PerformClick()
    End Sub

    Private Sub SortOptions_Click(ByVal sender As Object, _
            ByVal e As EventArgs) Handles btUnSort.Click, btLexicalic.Click, _
            btNumeric.Click, btComparisonNumeric.Click

        Select Case True
            Case sender Is btUnSort
                Shuffle(_Data)

            Case sender Is btLexicalic
                ' (für Inhaltsverzeichnisse unzureichende) Standard-Sortierung
                _Data.Sort()

            Case sender Is btNumeric
                ' benutzerdefinierte Sortierung mittels IComparer 
                ' implementierender Vergleicher-Klasse
                _Data.Sort(_Comparer)

            Case sender Is btComparisonNumeric
                ' benutzerdefinierte Sortierung mittels 
                ' Vergleicher(-Funktion(Comparison - Delegat))
                _Data.Sort(AddressOf modHelpers.NumericStringComparison)

        End Select
        Me.ListBox1.DataSource = Nothing
        Me.ListBox1.DataSource = _Data
        Me.ListBox1.SelectedIndices.Clear()
    End Sub

    Private Sub Search_Click(ByVal sender As Object, _
        ByVal e As System.EventArgs) _
        Handles btByMatch.Click, btBinarySearch.Click

        Me.ListBox1.SelectedIndices.Clear()
        Select Case True
            Case sender Is btByMatch
                ' Findet nur exakte Übereinstimmungen
                Me.ListBox1.SelectedIndex = _
                    _Data.FindIndex(AddressOf SearchPredicate)

            Case sender Is btBinarySearch
                ' Findet auch die Werte, die dem Suchbegriff am Nächsten kommen
                FindBinary()

        End Select
    End Sub

    Private Sub Shuffle(ByVal Lst As System.Collections.IList)
        Static Rnd As New Random()
        For I As Integer = 1 To Lst.Count - 1
            ' Lst(I) mit einer zufällig aus dem bisher durchlaufenem 
            ' Bereich gewählten vertauschen
            Dim II As Integer = Rnd.Next(I + 1)
            Dim Tmp As Object = Lst(I)
            Lst(I) = Lst(II)
            Lst(II) = Tmp
        Next
    End Sub

    ''' <summary>
    ''' Diese Function passt auf den im Framework vorgefertigten 
    ''' generischen Delegaten Predicate(Of T), und kann daher bei 
    ''' List(Of T).FindIndex() als Predicate angegeben werden
    ''' </summary>
    Private Function SearchPredicate(ByVal S As String) As Boolean
        Return S.Substring(0, S.IndexOf(" ")) = Me.TextBox1.Text
    End Function

    Private Sub FindBinary()
        ' während List(Of T).Sort() u.a. Comparisons akzeptiert, 
        ' bleibt BinarySearch() auf die IComparer-Schnittstelle 
        ' angewiesen. Warum?
        Dim Index As Integer = _Data.BinarySearch(Me.TextBox1.Text, _Comparer)

        ' Ein negativer Index ist das Bit-Komplement der fiktiven 
        ' **Einsortierposition**, wenn eine exakte Übereinstimmung 
        ' nicht gefunden wurde.
        Select Case Index
            Case Is >= 0
                Me.ListBox1.SelectedIndex = Index

            Case -1 ' kleiner als alle
                Me.ListBox1.SelectedIndex = 0

            Case -_Data.Count ' größer als alle
                Me.ListBox1.SelectedIndex = _Data.Count - 1

            Case Else ' 2 Item markieren die Einsortierposition
                Index = Index Xor -1
                Me.ListBox1.SelectedIndices.Add(Index)
                Me.ListBox1.SelectedIndices.Add(Index - 1)

        End Select
    End Sub
End Class


' ##############################################################################
' ################################ Helpers.vb ##################################
' ##############################################################################
Public Module modHelpers

    ''' <summary>
    ''' konvertiert etwa "2.11.3 Blabla" nach Integer(){2, 11, 3}
    ''' </summary>
    Private Function StringToNumbs(ByVal S As String) As Integer()
        Dim SpaceIndex As Integer = S.IndexOf(" ")
        If SpaceIndex < 0 Then SpaceIndex = S.Length
        Dim Splitted() As String = S.Substring(0, SpaceIndex).Split("."c)
        Dim RetVal(Splitted.Length - 1) As Integer

        For I As Integer = 0 To Splitted.Length - 1
            RetVal(I) = Integer.Parse(Splitted(I))
        Next
        Return RetVal
    End Function

    ''' <summary>
    ''' Diese Function passt auf den im Framework vorgefertigten 
    ''' generischen Delegaten Comparison(Of T), und kann daher bei 
    ''' List(Of T).Sort() als Comparison angegeben werden
    ''' </summary>
    Public Function NumericStringComparison(ByVal x As String, _
         ByVal y As String) As Integer

        Dim NumbsX As Integer() = StringToNumbs(x)
        Dim NumbsY As Integer() = StringToNumbs(y)
        For I As Integer = 0 To Math.Min(NumbsX.Length, NumbsY.Length) - 1
            Dim C As Integer = NumbsX(I).CompareTo(NumbsY(I))
            If C <> 0 Then Return C
        Next

        ' alle verglichenen Elemente waren gleich
        ' also den Vergleich der Länge der beiden Arrays zurückgeben
        Return NumbsX.Length.CompareTo(NumbsY.Length)
    End Function

End Module
' ##############################################################################
' ######################### NumericStringComparer.vb ###########################
' ##############################################################################
' Umständlichkeit der IComparer-Schnittstelle - für Sortierung überflüssig, da 
' man die Comparison auch direkt angeben kann, für die binäre Suche bleibt sie 
' leider erforderlich.
Public Class NumericStringComparer : Implements IComparer(Of String)
    Public Function Compare(ByVal x As String, ByVal y As String) As Integer _
          Implements System.Collections.Generic.IComparer(Of String).Compare
        Return modHelpers.NumericStringComparison(x, y)
    End Function
End Class