Wenn man die Häufigkeiten bestimmen will, mit denen unterscheidbare Elemente in einem Array vorliegen, kann man auf SHARED-Methoden der Klasse System.Array zurückgreifen. Die Methode 'Array.Sort' sortiert die Array-Elemente durch Verwendung des Standardcomparers des Datentyps oder durch einen benutzerdefinierten Vergleich. Die Methode 'Array.LastIndexOf' ermittelt den letzten Array-Index, bei dem ein bestimmter Wert vorkommt. Durch diese Information lassen sich in einem sortierten Array die Häufigkeiten direkt bestimmen. Die generische Methode 'Frequency' erwartet ein eindimensionales Array, dessen Elemente die IComparable-Schnittstelle implementiert haben. Ein Comparer kann übergeben werden. Die Elemente werden (lokal) ansteigend sortiert und die Häufigkeit der unterscheidbaren Elemente wird ermittelt. Die Rückgabe erfolgt in einer generischen Liste, die für jeden 'distinkten' Wert im Array ein Item der generischen Struktur 'StrucFrequency' enthält (ansteigend sortiert). Wird kein Comparer übergeben, verwendet die Funktion bei IEEE-Werten einen Comparer, der ggf. NaN-Werte nach hinten sortiert. Liegen solche Werte im Array vor, informiert deshalb der letzte Listen-Eintrag über deren Häufigkeit. Enthält das Array kein Element, wird eine Ausnahme ausgelöst. Die generische Funktion ist z.B. einsetzbar für Arrays deren Elemente Primitves, Decimals oder Strings sind. Man beachte, dass die Methode 'LastIndexOf' für den Vergleich der Array-Elemente bei benutzerdefinierten Klassen oder Strukturen nicht auf die Comparable-Schnittstelle zurückgreift, sondern eine geeignete Equals-Implementierung benötigt (generische Schnittstelle: IEquatable). (Die VB-Doku unterscheidet zwischen dem 'equality comparer' und dem 'ordering comparer'.) Als Demo ist die Klasse 'cls_Test' beigefügt, die zwei Integer-Werte kapselt und einen hierarchischen Vergleich implementiert. Der boolsche Equality-Comparer greift dabei auf den TriState-Ordering-Comparer zurück. Man beachte auch, dass die Methode 'LastIndexOf' mit Rückwärtssuche arbeitet. Der Parameter 'StartIndex', der bei einigen Überladungen enthalten ist, bezieht sich deshalb in diesem Fall auf den HÖCHSTEN Array-Index, ab dem abwärts gesucht wird. Um die Funktion 'Frequencies' benutzen zu können, muss das Modul 'modArray_Frequencies' dem Projekt hinzugefügt werden. Beispiel (Single-Array mit Sonderwerten): Public Sub Array_ElemFreq_Demo() ' Demo-Array erstellen Dim arr(10000) As Single ' Array mit Ganzzahl-Zufallswerten ' im Bereich -5 --> +5 füllen Fill_Array(arr, -5, 5) ' Einige Sonderwerte eintragen ' --> insgesamt 14 unterscheidbare Werte arr(500) = Single.NaN : arr(550) = Single.NaN arr(600) = Single.PositiveInfinity arr(650) = Single.PositiveInfinity arr(700) = Single.NegativeInfinity arr(750) = Single.NegativeInfinity ' Liste für Single-Werte und ihre Häufigkeiten vereinbaren Dim Freq_List As _ Collections.Generic.List(Of StrucFrequency(Of Single)) Try ' Unterscheidbare Werte und ihre Häufigkeiten bestimmen Freq_List = Frequencies(arr) Catch ex As Exception ' z.B. zu viele unterscheidbare Werte Windows.Forms.MessageBox.Show(ex.Message) Exit Sub End Try ' Listeninhalt in die Standardausgabe schreiben ' zu finden im IDE-Menü: Debuggen -> Fenster -> Ausgabe Dim sum As Integer For Each item As StrucFrequency(Of Single) In Freq_List Console.WriteLine _ ("Wert:= " & CStr(item.value) & _ " Freq:= " & CStr(item.frequency)) ' Summe aller Häufigkeiten ermitteln sum += item.frequency Next item ' Diese Bedingung darf nicht auftreten If arr.Length <> sum Then Stop End Sub Public Sub Fill_Array(Of T)(ByRef arr() As T, _ Optional ByVal MinRnd As Integer = -1000, _ Optional ByVal MaxRnd As Integer = 1000) MaxRnd += 1 ' Obergrenze in Intervall einschließen ' Hilfsfunktion: Array mit Integer-Randoms füllen Dim rndm As New Random(1000) For i As Integer = 0 To arr.Length - 1 To_T(rndm.Next(MinRnd, MaxRnd), arr(i)) Next End Sub Private Sub To_T(Of T1, T2) (ByVal arg1 As T1, ByRef arg2 As T2) ' Typ-Konvertierung des Arguments: T1 -> T2 arg2 = CType(Convert.ChangeType(arg1, GetType(T2)), T2) End Sub Beispiel für die Anwendung bei einer benutzerdefinierten Klasse: Public Sub Array_ElemFreq_Demo2() ' Demo-Array erstellen Dim arr(10000) As cls_Test Dim rndm As New Random(1000) ' Objekt-Instanzen mit Ganzzahl-Zufallswerten ' im Bereich -3 --> +3 füllen For i As Integer = 0 To arr.Length - 1 arr(i) = New cls_Test(rndm.Next(-3, 4), rndm.Next(-3, 4)) Next i Dim Freq_List As _ Collections.Generic.List(Of StrucFrequency(Of cls_Test)) = _ Frequencies(arr) ' Listeninhalt in die Standardausgabe schreiben For Each item As StrucFrequency(Of cls_Test) In Freq_List Console.WriteLine _ ("Wert x:= " & CStr(item.value.x) & _ " Wert y:= " & CStr(item.value.y) & _ " Freq:= " & CStr(item.frequency)) Next item End Sub Das Modul 'modArray_Frequencies' enthält die Funktion 'Frequencies', die Listen-Struktur 'StrucFrequency' und den internen IEEE-Comparer. Option Strict On Option Explicit On Imports System Module modArray_Frequencies ''' <summary>Speichert eim T-Element und eine Häufigkeit</summary> ''' <typeparam name="T">DatenTyp</typeparam> Public Structure StrucFrequency(Of T As Icomparable) ''' <summary>Wert (EntryType)</summary> Dim value As T ''' <summary>Häufigkeit des Wertes</summary> Dim frequency As Integer End Structure ''' <summary>Bestimmung der Häufigkeit unterscheidbarer Array-Elemente ''' </summary> ''' <typeparam name="T">DatenTyp der Artray-Elemente</typeparam> ''' <param name="arr">Array (IComparable)</param> ''' <param name="Comparer">optional: Vergleich der Elemente</param> ''' <returns>Liste der unterscheidbaren Elemente (und Häufigkeiten)</returns> Public Function Frequencies(Of T As IComparable) (ByVal arr() As T, _ Optional ByVal Comparer _ As Collections.Generic.IComparer(Of T) = Nothing) _ As Collections.Generic.List(Of StrucFrequency(Of T)) ' maximal zulässige Anzahl distinkter Werte Const cMaxValues As Integer = 500 ' Array checken If arr Is Nothing Then Throw New ArgumentNullException("Kein Array!") End If If arr.Length < 1 Then Throw New ArgumentException("Keine Artray-Elemente!") End If ' Array-Elemente (=Werttypen) lokal machen ReDim Preserve arr(arr.GetUpperBound(0)) ' Array-Elemente ansteigend sortieren If Comparer Is Nothing Then If GetType(T).Equals(GetType(Double)) Or _ GetType(T).Equals(GetType(Single)) Then ' (IEEE-Comparer) Array.Sort(arr, New IEEE_Comparer(Of T)) Else ' (Standard-Comparer) Array.Sort(arr) End If Else ' (übergebener Comparer) Array.Sort(arr, Comparer) End If ' Liste: speichert unterscheidbare Werte und ihre Häufigkeiten Dim FrequencyList As New Collections.Generic.List(Of StrucFrequency(Of T)) ' einzelnes Listen-Item Dim sf As StrucFrequency(Of T) ' Bestimmung der unterscheidbaren Elemente und ihrer ' Häufigkeit im Array Dim id As Integer = 0, end_id As Integer ' ArrayIndices While id < arr.Length ' Bis zu welchem Index gibt es ' den Wert an Position arr(id)? end_id = Array.LastIndexOf(arr, arr(id)) ' Wert und Häufigkeit notieren .... sf.value = arr(id) sf.frequency = end_id - id + 1 ' ... und an der Liste anhängen FrequencyList.Add(sf) ' Listenüberlänge verhindern If FrequencyList.Count > cMaxValues Then Throw New DistinctValues_TooMuch End If ' Index des nächsten unterscheidbaren ' Wertes im sortieren Array id = end_id + 1 End While ' Rückgabe der Liste Return FrequencyList End Function ''' <summary>Comparer für IEEE-Werte ('NaN' > gültige Werte)</summary> Private Class IEEE_Comparer(Of T) Implements Collections.Generic.IComparer(Of T) ''' <summary>Vergleich von zwei IEEE-Werten (NaN > IEEE-Werte) ''' </summary> ''' <param name="x">1. IEEE-Wert</param> ''' <param name="y">2. IEEE-Wert</param> ''' <returns>Vergleichsergebnis</returns> Public Function Compare(ByVal x As T, _ ByVal y As T) As Integer _ Implements Collections.Generic.IComparer(Of T).Compare Dim dbl_x As Double = Convert.ToDouble(x) Dim dbl_y As Double = Convert.ToDouble(y) ' NaN-Wert? Dim is_x_undef As Boolean = Double.IsNaN(dbl_x) Dim is_y_undef As Boolean = Double.IsNaN(dbl_y) ' Vergleich durchführen If is_x_undef And is_y_undef Then Return 0 ElseIf is_x_undef Then Return 1 ElseIf is_y_undef Then Return -1 ElseIf dbl_x = dbl_y Then Return 0 ElseIf dbl_x > dbl_y Then Return 1 Else Return -1 End If End Function End Class Public Class DistinctValues_TooMuch Inherits Exception Public Sub New() MyBase.New("Zu viele unterscheidbare Werte im Array") End Sub ' New End Class End Module Benutzerdefinierte Demo-Klasse 'cls_Test': ''' <summary>Demoklasse: kapselt zwei Integer-Werte</summary> Public Class cls_Test Implements IEquatable(Of cls_Test) Implements IComparable Public x As Integer Public y As Integer Public Sub New(ByVal x1 As Integer, ByVal y1 As Integer) x = x1 : y = y1 End Sub ''' <summary>Für die IComparable-Schnittstelle implementiert ''' </summary> ''' <param name="obj">Vergleichs-Instanz</param> ''' <returns>Vergleichsergebnis</returns> Public Function CompareTo(ByVal obj As Object) As Integer _ Implements System.IComparable.CompareTo Dim v_obj As cls_Test = CType(obj, cls_Test) With v_obj If Me.x > .x Then Return 1 If Me.x < .x Then Return -1 If Me.x = x Then If Me.y > .y Then Return 1 If Me.y < .y Then Return -1 End If Return 0 End With End Function ''' <summary>Implementiert für den Bool-Vergleich</summary> ''' <param name="other">zu vergleichende Instanz</param> ''' <returns>Sind die Instanzen gleich-wertig?</returns> Public Function Equals1(ByVal other As cls_Test) As Boolean _ Implements System.IEquatable(Of cls_Test).Equals If Me.CompareTo(other) = 0 Then Return True Return False End Function End Class Dieser Tipp wurde bereits 11.189 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |