vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
NEU! sevCoolbar 3.0 - Professionelle Toolbars im modernen Design!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2018
 
zurück
Rubrik: Variablen/Strings · Array/ArrayList   |   VB-Versionen: VB2005, VB200805.03.09
Häufigkeit unterscheidbarer Werte in einem Array

Eine generische Methode zur Ermittlung der Häufigkeit unterscheidbarer Werte in einem Array unter Verwendung von 'LastIndexOf'.

Autor:   Manfred BohnBewertung:     [ Jetzt bewerten ]Views:  8.427 
ohne HomepageSystem:  Win2k, WinXP, Vista, Win7, Win8, Win10kein Beispielprojekt 

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 8.427 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!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.
 
   

Druckansicht Druckansicht Copyright ©2000-2018 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel