Tipp-Upload: VB.NET 0133: VB 2008: Sort and Search

Hinweis zum Tippvorschlag  

Dieser Vorschlag wurde noch nicht auf Sinn und Inhalt überprüft und die Zip-Datei wurde noch nicht auf schädlichen Inhalt hin untersucht.
Bitte haben Sie ein wenig Geduld, bis die Freigabe erfolgt.

Über den Tipp  

Dieser Tippvorschlag ist noch unbewertet.

Der Vorschlag ist in den folgenden Kategorien zu finden:

• Algorithmen
• Sonstiges

Dem Tippvorschlag wurden folgende Schlüsselwörter zugeordnet:
VB9,VB 2008, suche, binär, sortieren, Comparison, Predicate, extension, binarysearch, anonyme, anonym,lambda,linq

Der Vorschlag wurde erstellt am: 22.10.2007 04:08.
Die letzte Aktualisierung erfolgte am 05.02.2009 15:43.

Zurück zur Übersicht

Beschreibung  

Portierung  VB.NET Tipp 80 (Sortieren und Filtern mit dem Framework) nach VB9
Benutzerdefiniertes Sortier-Verfahren, binäre Suche, Verwendung der IComparer-Schnittstelle, der Delegaten Comparison(Of T) und Predicate(Of T).
Die eigentlichen Such- / Sortier- Algorithmen sind im Framework fertig enthalten. Beim Abruf kann man geeignete Delegaten angeben, mit denen das Treffer / Sortier - Verhalten definiert wird.
Im Beispiel wird ein fiktives Inhaltsverzeichnis ( "1.2.3 Text" etc. ) bearbeitet.

Zu den gezeigten neuen VB9-Features:
Type-inference anonyme Function (bzw. Lambda-Expressions), Extension-Functions, Linq-Query
empfehle ich auch die "Hands on Lab"-Dokus der MS-Sample-Page

Schwierigkeitsgrad

Verwendete API-Aufrufe:

Download: Download des Beispielprojektes [17,13 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 SortAndSearchVB9.sln  --------
' ------- Anfang Projektdatei SortAndSearchVB9.vbproj  -------
' ----------- Anfang Datei frmSortAndSearchVB9.vb  -----------
' IDE-Voreinstellungen:
' Option Strict On
' Option Explicit On
' Option Infer On

Public Class frmSortAndSearchVB9

    Private _Data As New List(Of String)

    Private Sub frmSortAndSearchVB9_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
        ' VB9: die Type-Inference erkennt Numbs Typ anhand der Initialisierung
        Dim Numbs = New Integer() {1, 2, 3, 9, 10, 11}

        For Each I In Numbs

            ' VB9: Aufruf meiner Extensions ConcatWith() und AddTo()
            I.ConcatWith(" Text").AddTo(_Data)

            For Each II In Numbs
                I.ConcatWith(".", II, " Text").AddTo(_Data)

                For Each III In Numbs
                    I.ConcatWith(".", II, ".", III, " Text").AddTo(_Data)
                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

        Select Case True

            Case sender Is btUnSort
                Unsort()

            Case sender Is btLexicalic
                _Data.Sort() ' (unzureichende) Standard-Sortierung

            Case sender Is btNumeric

                ' benutzerdefinierte Sortierung mittels Vergleicher-Funktion (Comparison-Delegat)
                _Data.Sort(AddressOf 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 EventArgs) _
                Handles btByMatch.Click, btBinarySearch.Click

        Me.ListBox1.SelectedIndices.Clear()

        Select Case True

            Case sender Is btByMatch

                ' Übereinstimmungen suchen
                ' VB9: statt eines Predicates ist gleich die ganze Predicate-Function
                ' übergeben (anonyme Function, Lambda-Expression).
                ' S as String wird inferiert aus dem von FindIndex() erwarteten Typ, nämlich
                ' Predicate(Of String)
                Me.ListBox1.SelectedIndex = _Data.FindIndex(Function(S) S.LeftCut(" ") = _
                    Me.txtSearch.Text)

            Case sender Is btBinarySearch

                ' findet auch die Werte, die dem Suchbegriff am nächsten kommen
                FindBinary()

        End Select

    End Sub

    Private Sub Unsort()

        Static Rnd As New Random

        For I = _Data.Count - 1 To 0 Step -1

            Dim Index = Rnd.Next(0, I)          ' zufälliges Element...

            _Data.Add(_Data(Index))             ' am Ende anfügen...
            _Data.RemoveAt(Index)               ' am Index entfernen
        Next

    End Sub

    Private Sub FindBinary()

        ' VB9: Aufruf meiner List(Of T)-Extension "BinarySearch"
        Dim Index = _Data.BinarySearch(Me.txtSearch.Text, AddressOf NumericStringComparison)

        ' 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

    ''' <summary>
    ''' konvertiert etwa "2.11.3 Blabla" nach Integer(){2, 11, 3}
    ''' </summary>
    Private Function StringToNumbs(ByVal S As String) As Integer()

        ' VB9 - If(S.LeftCut(" "), S)
        ' Falls S.LeftCut() als Nothing ausgewertet wird, wird der 2. Parameter - S - verwendet
        Dim Splitted() = If(S.LeftCut(" "), S).Split("."c)

        ' VB9: meine ConvertAll-Extension, kombiniert mit anonymer Converter-Function
        Return Splitted.ConvertAllX(Function(str) Integer.Parse(str))

    End Function

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

        Dim NumbsX = StringToNumbs(x)
        Dim NumbsY = StringToNumbs(y)

        For I = 0 To Math.Min(NumbsX.Length, NumbsY.Length) - 1

            Dim C = NumbsX(I).CompareTo(NumbsY(I))

            If C <> 0 Then Return C
        Next

        ' alle verglichenen Elemente waren gleich
        ' letzte Vergleichsmöglichkeit: Länge der beiden Arrays
        Return NumbsX.Length.CompareTo(NumbsY.Length)

    End Function

    Private Sub ckFilter_CheckedChanged( _
                ByVal sender As System.Object, ByVal e As System.EventArgs) _
                Handles ckFilter.CheckedChanged

        ' VB9: Linq-Query:
        Dim Expr = From S In _Data Where S Like Me.txtFilter.Text

        ' VB9: Lambda-Expression:
        ' Dim Expr = _Data.Where(Function(S) S Like Me.txtFilter.Text)
        Me.ListBox1.DataSource = If(ckFilter.Checked, Expr.ToList, _Data)

    End Sub

End Class

' ------------ Ende Datei frmSortAndSearchVB9.vb  ------------
' ------------ Anfang Datei GenericExtensions.vb  ------------
Imports System.Runtime.CompilerServices
Imports System.Collections

''' <summary>
''' generische Extension-Functions erweitern eine Vielzahl von; oder sogar alle Klassen - nämlich
''' wenn ohne Typ-Einschränkung implementiert
''' </summary>
''' <remarks>
''' Wo möglich, setze ich 2 Prinzipien um: 
''' 1) Ursprünglich Public Shared Functions binde ich als Object-Functions 
''' an die Klassen, auf die sie anwendbar sind 
''' <example>Shared Integer.Parse(String) -> (String)Subject.ParseToInt()</example> 
''' 2) möglichst ein Object returnen, auf dem weitere Operationen direkt 
''' ausgeführt werden können 
''' <example>I.ConcatWith(" Text").AddTo(_Data)</example>
''' Das kann auch das "Subjekt" selbst sein ( wie bei AddTo() ). 
''' </remarks>
Public Module GenericExtensions

    <Extension()> _
        Public Function ConvertAllX(Of TInput, TOutput)( _
                ByVal Subj As TInput(), _
                ByVal Conv As Converter(Of TInput, TOutput)) As TOutput()

        Return Array.ConvertAll(Subj, Conv)

    End Function

    <Extension()> _
        Public Function CloneX(Of T As ICloneable)(ByVal Subj As T) As T

        ' hat mich schon immer angek..., daß Klone einen anderen Typ hatten als ihr Template
        Return DirectCast(Subj.Clone, T)

    End Function

    <Extension()> _
        Public Function AddTo(Of T)(ByVal Subj As T, ByVal Collection As IList) As T

        ' statt: Collection.Add(Obj)
        ' implementiere ich: Subj.AddTo(Collection)
        ' ermöglicht verkettete Aufrufe: Subj.AddTo(Col1).AddTo(Col2)
        Collection.Add(Subj)
        Return Subj

    End Function

    <Extension()> _
        Public Function BinarySearch(Of T)( _
                ByVal Subj As List(Of T), _
                ByVal Pattern As T, _
                ByVal Comparison As Comparison(Of T)) As Integer

        ' ermöglicht, List(Of T).BinarySearch mit Comparisons aufzurufen, statt umständlich
        ' eine IComparer-Klasse implementieren zu müssen
        Return Subj.BinarySearch(Pattern, Comparison.ToComparer)

    End Function

    <Extension()> _
        Public Function BinarySearch(Of T)( _
                ByVal Subj As T(), _
                ByVal Pattern As T, _
                ByVal Comparison As Comparison(Of T)) As Integer

        ' "Verobjektivierung" von Shared Array.BinarySearch(), außerdem Comparisons akzeptierend
        Return Array.BinarySearch(Subj, Pattern, Comparison.ToComparer)

    End Function

    ''' <summary>
    ''' konvertiert eine Comparison in ein IComparer-implementierendes Objekt
    ''' </summary>
    ''' <remarks>selbst einen Delegaten kann man also erweitern</remarks>
    <Extension()> _
        Public Function ToComparer(Of T)(ByVal Subj As Comparison(Of T)) As IComparer(Of T)

        ' dieses enthebt einen der Lästigkeit, jedesmal eine IComparer-Klasse coden zu
        ' müssen, wenn das Framework diese m.E. veraltete Schnittstelle verlangt
        Return New ComparisonComparer(Of T)(Subj)

    End Function

    ''' <summary>
    ''' IComparer-implementierender Wrapper um eine Comparison 
    ''' </summary>
    Public Class ComparisonComparer(Of T)

        Implements IComparer(Of T)

        Private _Comparison As Comparison(Of T)

        Public Sub New(ByVal Comparison As Comparison(Of T))

            _Comparison = Comparison

        End Sub

        Public Function Compare(ByVal x As T, ByVal y As T) As Integer _
                  Implements IComparer(Of T).Compare

            Return _Comparison(x, y)

        End Function

    End Class

End Module

' ------------- Ende Datei GenericExtensions.vb  -------------
' ------------- Anfang Datei StringExtensions.vb -------------
Imports System.Runtime.CompilerServices
Imports System.Collections

Public Module StringExtensions

    ''' <summary>
    ''' gibt den String-Abschnitt links des ersten gefundenen Matches zurück
    ''' </summary>
    <Extension()> _
        Public Function LeftCut(ByVal Subj As String, ByVal Pattern As String) As String

        Dim Index = Subj.IndexOf(Pattern)

        If Index >= 0 Then
            Return Subj.Substring(0, Index)

        Else

            Return Nothing
        End If

    End Function

    <Extension()> Public Function ConcatWith(ByVal Subj As Object, ByVal ParamArray Args() As _
        Object) As String

        ' Quasi-Umbau von Shared String.Concat() in eine Object-Function
        Return Subj.ToString & String.Concat(Args)

    End Function

    <Extension()> _
        Public Function ParseToInt(ByRef Subj As String) As Integer

        ' Umbau von Shared Integer.Parse() in eine String-Object-Function
        Return Integer.Parse(Subj)

    End Function

End Module

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

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