Kontrollierte Abfrage numerischer Werte durch Extension Methods Modul zur Überwachung der Ausprägung von Doublewerten während der Durchführung umfangreicher Berechnungen durch kontrollierte und protokollierte Abfrage der Werte
Autor:  Manfred Bohn	Bewertung:     [ Jetzt bewerten ]	Views:  10.526

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 2 Bewertung insgesamt: sehr gut Durchschnittliche Bewertung: 4.5 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Die Compiler-Direktive 'Extension' (in System.Runtime.CompilerServices) ermöglicht es, 'Subs' und 'Functions', die in einem Modul vereinbart sind, im VB-Code wie die Methoden einer Klasse aufzurufen.

Zweckmäßig ist die Verwendung der 'Extension'-Direktive insbesondere bei Klassen, die nicht 'geerbt' werden können.

Ein Modul, das solche Extensions enthält, sollte im 'NameSpace' einer Klassenbibliothek enthalten sein, damit es möglich wird, durch entsprechende Imports-Anweisungen zu steuern, welche Extension-Module in einer bestimmten Code-Datei verfügbar sind. Das reduziert die Verwechslungsgefahr.

Das Modul modDoubleEx demonstriert einige Routinen, die als 'Extension Methods' aufgerufen werden können - zur Werte-Abfrage (bei Variablen des IEEE-Datentyps 'Double'). Diese Routinen lösen bei ungeeigneten Argumenten Ausnahmen aus und sollten deshalb nur innerhalb von Try-Catch-Blöcken gerufen werden. Das Modul dient in erster Linie zur Unterstützung bei der kontrollierten Berechnung komplexer numerischer Algorithmen.

Beim Datentyp 'Double' von Interesse:

• die Kontrolle und das Filtern der Werte;
• die Prüfung der Konvertierbarkeit;
• kontrollierte Rundungsoperationen;
• die Registrierung von Limit-Verstößen.

Routinen im Modul 'modDoubleEx':
Die Routine GetValue löst eine Ausnahme aus, wenn bei der Abfrage ein IEEE-Sonderwert in der Variable enthalten ist.

Die Routine SetRange erlaubt die Definition einer zulässigen Spannweite für Werte, die 'ausnahmefrei' aus einer Double-Variable abgefragt werden können. Nach dem Setzen eines 'Range'-Bereichs werfen die Routinen eine Exception, falls der enthaltene Wert außerhalb der gültigen Grenzen liegt. Die Routine 'GetValue_SetToRange' löst in solchen Fällen keine Ausnahme aus, sondern gibt bei Ausreißer-Argumenten den zulässigen Grenzwert zurück - der Variablen-Inhalt bleibt dabei unverändert. Die Routine 'ClearRange' gibt den gesamten Double-Bereich für die Abfrage-Extensions wieder frei.

Die Routine SetThreshold setzt eine kritische Schranke. Ist diese Ausprägung bei einer Abfrage überschritten, erfolgt die Registrierung in der zugehörigen Counter-Variable, die durch 'GetThreshold_Counter' abgefragt werden kann ('stiller Alarm').

Die Routine GetValue_NaN setzt nach der Wertabfrage den Inhalt der Variable auf 'Double.NaN' ( = Not a Number). Der Versuch einen 'NaN'-Wert abzufragen, führt zu einer Ausnahme. Auf diese Weise wird bewirkt, dass ein zugewiesener Wert nur einmal abgefragt werden kann - dann ist er verloren. (In diesem Fall wird der Variablen-Inhalt durch die Extension geändert: ByRef-Parameter). Bei darauf folgenden direkten Zuweisungen des Typs x = y wird der 'NaN'-Wert an die Ziel-Variable weitergegeben!

Die Routine IsLong dient der Überprüfung, ob der in einer Double-Variable aktuell enthaltene Wert ohne nennenswerten Genauigkeitsverlust auf eine Variable des Typs 'Long' zugewiesen werden kann. 'IsSingle' überprüft ob der Wert im Geltungsbereich des Datentyps 'Single' liegt.

Die Funktion Round4 rundet den zurückgegebenen Wert auf vier Nachkommastellen und überwacht dabei die Wertausprägung. Es müssen im Argument mindestens fünf Nachkommastellen hinreichend korrekt darstellbar sein, sonst ist eine Rundung auf vier Stellen eher witzlos. Falls erforderlich, wird deshalb eine Ausnahme ausgelöst.

Die Prozedur Round rundet den IN DER VARIABLE ENTHALTENEN Wert auf die geforderte Nachkomma-Stellenzahl.

Die Routine GetIn fragt den Wert der Variable ab, wobei die Rückgabe stets in den gegebenen Grenzen liegt. Bei dieser Routine lösen Grenzüberschreitungen weder eine Ausnahme aus, noch werden sie durch eine der globalen Variablen registriert.

Die Routine GetUnSafe gibt den Wert der Variable völlig unkontrolliert zurück. y = x.GetUnSafe entspricht y = x

Die Funktion NearBy prüft, ob zwei Double-Werte so nahe beieinander liegen, dass sie als gleich gelten können.

Modulglobale Variablen in 'modDoubleEx':
Modulglobale Variable können auf verschiedene Weise bei Programmierung von 'Extension Methods' einbezogen werden. Zu beachten ist, dass sie sich stets auf alle Variablen beziehen, die die 'Extensions' aufrufen können.

Im Beispiel-Modul ist ein 'Access_Counter' enthalten, der alle über die Extensions ausgeführten Wert-Abfragen aller Double-Variablen zählt. Die Variable 'gTime_LastAccess' enthält den Zeitpunkt der letzten Abfrage eines Wertes. (In der Praxis würde man einen 'TickCounter' verwenden, um eine sinnvolle Genauigkeit zu erreichen.)

Bei jeder gültigen Abfrage eines Wertes wird geprüft, ob es sich dabei um den bisher größten oder kleinsten Wert handelt. Die Extreme werden registriert und können durch die Routine 'GetMinMax' abgefragt werden. Die Re-Initialisierung geschieht durch 'ResetMinMax'. 'GetMinMax' wirft eine Ausnahme, falls vor dem Aufruf noch keine Werte abgefragt worden sind.

Wenn man 'Extension Methods' für einen allgemein einsetzbaren Datentyp wie 'Double' erstellt, sollte man darauf achten, dass diese Routine auch tatsächlich für alle Argumente und Anwendungsfälle sinnvoll einsetzbar ist. Die Demo-Methode 'Sphere' berechnet aus einem Radius die Oberfläche einer Kugel. Sie ist nur verwendbar, wenn das Argument auch tatsächlich einen Kugelradius darstellt und deshalb als Extension für den Datentyp 'Double' ungeeignet.

Die Routine Swap vertauscht den Inhalt von zwei Double-Variablen. Sie ist zwar allgemein verwendbar, aber der ''reguläre' Aufruf Swap(x, y) ist im Code klarer lesbar als der Extension-Aufruf x.Swap(y). Auch in solchen Fällen sollte die Compiler-Direktive nicht benutzt werden.

Demo-Code

' Deklaration von zwei Double-Variablen 
Dim a, b As Double
 
' Zuweisung eines IEEE-Sonderwerts
a = Double.PositiveInfinity
 
Try
  ' Dieser Versuch löst eine Ausnahme aus
  ' Kontroll-Extensions mögen keine Sonderwerte
  b = a.GetValue
Catch ex As Exception
  MsgBox(ex.Message)
End Try
 
' ...die hier aber schon 
b = a.GetUnSafe ' entspricht: b = a
 
' Zuweisung eines Double-Wertes
a = 100012.7456
 
' Jetzt gibt es bei der Abfrage kein Problem
b = a.GetValue
 
' Einen zulässigen Wertebereich setzen:
SetRange(101, 200)
 
Try
  ' Jetzt wird die Ausnahme ausgelöst, weil der
  ' Wert in 'a' nicht im Range-Bereich liegt
  b = a.GetValue
Catch ex As Exception
  MsgBox(ex.Message)
End Try
 
' Die Range-Überwachung wird gelöscht ....
ClearRange()
 
' ... dafür wird ein stiller Alarm eingerichtet
SetThreshold(200)
 
' Jetzt löst diese Zuweisung keine Ausnahme aus.
' Die Schrankenüberschreitung wird im Modul notiert
b = a.GetValue
 
' Verwendung der Extension in einem Ausdruck
b = (a.GetValue ^ 2) / a.GetValue
 
' a und b sollten jetzt 'nahezu' gleich sein
' --> die Extension prüft das: 
' Stop wird nicht ausgelöst
If Not b.NearBy(a) Then Stop
 
' Der Wert in 'a' geht als Single durch, 
' aber kann nicht als 'Long' gelten
' --> Die Bedingungen werden nicht ausgelöst
If Not a.IsSingle Then Stop
If a.IsLong Then Stop
 
' Diese Zuweisung auf 'b' löscht 
' den Wert in 'a'
b = a.GetValue_NaN
 
' Der Wert in 'b' wird ganzahlig gerundet
b.Round(0)
' Diese Bedingung wird wg. Runden nicht ausgelöst 
If Not b.IsLong Then Stop
 
Try
  ' Da läuft jetzt nichts mehr
  b = a.GetValue
Catch ex As Exception
  MsgBox(ex.Message)
End Try
 
' Die Abfrage-Vorgänge überprüfen .....
' ======================================
If GetException_Counter() > 0 Then
  MsgBox("Bei Wert-Abfragen sind " + _
    CStr(GetException_Counter()) + _
    " mal Ausnahmen ausgelöst worden")
End If
 
If GetThreshold_Counter() > 0 Then
  MsgBox("Die kritische Schranke ist " + _
    "insgesamt " + CStr(GetThreshold_Counter()) + _
    " mal überschritten worden !")
End If
 
MsgBox("Letzter Double-Zugriff per Extension: " + vbCrLf + GetTime_LastAccess())
 
GetMinMax(a, b)
MsgBox("Spannweite der per Extension " + "abgefragten Werte: " + vbCrLf + _
  CStr(a) + " bis " + CStr(b))

Das Modul emDoubleEx

Option Strict On
Option Explicit On
Option Infer Off
 
' Namespace, der die Direktive 'Extension' enthält 
Imports System.Runtime.CompilerServices
Namespace emDoubleEx

''' <summary>
''' Demo-Modul für 'Extension Methods' für die
''' kontrollierte Abfrage des Werts in einer 
''' Double-Variable
''' </summary>
<Extension()> _
Public Module modDoubleEx
 
  ' zulässige Wertespannweite
  ' für die Abfrage-Routinen (optional)
  ' (incl. Initialisierung)
  Private gMinValue As Double = Double.MinValue
  Private gMaxValue As Double = Double.MaxValue
  Private gLimits As Boolean = False
 
  ' kritische Schranke
  Private gThreshold As Double = Double.MaxValue
  Private gThreshold_Counter As Long = 0
 
  ' Register der Extreme der abgefragten Werte
  Private gMaximum As Double = Double.MinValue
  Private gMinimum As Double = Double.MaxValue
 
  ' Zeitpunkt der Letzten Abfrage
  Private gTime_LastAccess As String = ""
 
  ' Zugriffszähler
  Private gAccess_Counter As Long = 0
 
  Private gException_Counter As Long = 0

  '=================================================
  ' Extensions für die kontrollierte Abfrage
  '=================================================

  ''' <summary>
  ''' Die Abfrage löst eine Ausnahme aus, falls
  ''' ein IEEE-Sonderwert enthalten ist oder
  ''' ein (optionaler) Limit-Verstoß vorliegt
  ''' </summary>
  <Extension()> _
  Public Function GetValue(ByVal x As Double) As Double
    If Double.IsInfinity(x) Or Double.IsNaN(x) Then
      gException_Counter += 1
      Throw New NotFiniteNumberException
    End If
    If gLimits Then
      ' zulässigen Bereich prüfen
      If x > gMaxValue Or x < gMinValue Then
        gException_Counter += 1
        Throw New ArgumentOutOfRangeException
      End If
    End If
    ' Abfrage registrieren
    Adjust_Globals(x)
    ' abgefragten Wert zurückgeben
    Return x
  End Function

  ''' <summary>
  ''' Die Abfrage setzt Ausreißerwerte auf
  ''' die Grenzwerte (falls welche gesetzt)
  ''' </summary>
  <Extension()> _
  Public Function GetValue_SetToRange(ByVal x As Double) As Double
    If Not gLimits Then
      ' Keine Limits gesetzt
      gException_Counter += 1
      Throw New InvalidOperationException
    End If
    Dim ret As Double = x
    If ret > gMaxValue Then ret = gMaxValue
    If ret < gMinValue Then ret = gMinValue
    Adjust_Globals(ret)
    Return ret
  End Function

  ''' <summary>
  ''' Die Abfrage setzt den Variablen-Wert 
  ''' auf 'NaN' und löst eine Ausnahme aus, 
  ''' falls 'NaN' bereits enthalten ist
  ''' </summary>
  <Extension()> _
  Public Function GetValue_NaN(ByRef x As Double) As Double
    ' Wert abfragen
    Dim arg As Double = x.GetValue
    ' x nach der Abfrage auf NaN setzen
    x = Double.NaN
    Return arg
  End Function

  ''' <summary>
  ''' Läßt sich ein Double-Wert mit hoher Genauigkeit 
  ''' in einen Long-Wert transformieren? 
  ''' </summary>
  ''' <returns>true: Long ist möglich, 
  ''' sonst false</returns>
  <Extension()> _
  Public Function IsLong(ByVal x As Double) As Boolean
    Dim y As Double = x.GetValue
    If y > Long.MaxValue Then Return False
    If y < Long.MinValue Then Return False
    Return iNearBy(y, CLng(y))
  End Function

  ''' <summary>
  ''' Läßt sich ein Double-Wert 
  ''' in einen Single-Wert transformieren? 
  ''' (nur Range-Kontrolle)
  ''' </summary>
  ''' <returns>true: Single ist möglich, 
  ''' sonst false</returns>
  <Extension()> _
  Public Function IsSingle(ByVal x As Double) As Boolean
    Dim y As Double = x.GetValue
    If y > Single.MaxValue Then Return False
    If y < Single.MinValue Then Return False
    Return True
  End Function

  ''' <summary>
  ''' Der Wert wird kontrolliert gerundet auf vier 
  ''' Nachkommastellen zurückgegeben
  ''' (MidPointRounding.AwayFromZero)
  ''' </summary>
  <Extension()> _
  Public Function Round4(ByVal x As Double) As Double
    Dim y As Double = x.GetValue
    If Math.Abs(x) > 999999999 Then
      gException_Counter += 1
      Throw New ArgumentOutOfRangeException
    End If
    Return Math.Round(y, 4, _
    System.MidpointRounding.AwayFromZero)
  End Function

  ''' <summary>
  ''' Die Inhalt der Variable wird gerundet
  ''' (MidPointRounding.AwayFromZero)
  ''' </summary>
  ''' <param name="x"></param>
  ''' <param name="digits">Zahl der Nachkommastellen
  ''' (0-10)</param>
  <Extension()> _
  Public Sub Round(ByRef x As Double, _
    Optional ByVal digits As Integer = 2)
 
    If digits < 0 Or digits > 10 Then
      gException_Counter += 1
      Throw New ArgumentOutOfRangeException
    End If
    Dim y As Double = x.GetValue
    x = Math.Round(y, digits, _
    MidpointRounding.AwayFromZero)
  End Sub

  ''' <summary>
  ''' Abfrage eines Wertes
  ''' falls erforderlich: Rückgabe des Grenzwertes 
  ''' </summary>
  ''' <param name="x">abgefragte Variable</param>
  ''' <param name="ug">Untergrenze der Abfrage</param>
  ''' <param name="og">Obergrenze der Abfrage</param>
  ''' <returns>kontrolliert abgefragter Wert</returns>
  <Extension()> _
  Public Function GetIn(ByVal x As Double, _
    ByVal ug As Double, ByVal og As Double) As Double
 
    ' Diese Routine akzeptiert Infinity-Werte in 'x'
    ' und setzt sie wie gewöhnliche Ausreißer 
    ' auf ug bzw. og
 
    ' Prüfung der Grenzen (ohne Registrierung)
    If Double.IsNaN(ug) Or Double.IsNaN(og) Then
      Throw New NotFiniteNumberException
    End If
    If ug > og Then
      Throw New ArgumentException
    End If
 
    If Double.IsNaN(x) Then
      gException_Counter += 1
      Throw New NotFiniteNumberException
    End If
 
    Dim ret As Double = x
    If ret > og Then ret = og
    If ret < ug Then ret = ug
    Return ret
  End Function

  ''' <summary>
  ''' völlig unkontrolliertes Auswerfen des enthaltenen 
  ''' Wertes - leider aktueller VB-Standard
  ''' </summary>
  ''' <param name="x">abgefragte Variable</param>
  <Extension()> _
  Public Function GetUnSafe(ByVal x As Double) As Double
    Return x
  End Function

  ''' <summary>
  ''' Können zwei kontrolliert abgefragte 
  ''' Double-Werte als gleich gelten?
  ''' </summary>
  ''' <param name="x"></param>
  ''' <param name="y"></param>
  ''' <returns>true: Die Werte können als gleich gelten
  ''' </returns>
  <Extension()> _
  Public Function NearBy(ByVal x As Double, ByVal y As Double) As Boolean
    Dim xi As Double = x.GetValue
    Dim yi As Double = y.GetValue
    Return iNearBy(xi, yi)
  End Function
 
  Private Function iNearBy(ByVal x As Double, ByVal y As Double) As Boolean
    ' Interner Vergleich bereits aus der 
    ' rufenden Variable abgefragter Werte
    Dim eps As Double = 0.0000000001
    Dim mx As Double = Math.Max(Math.Abs(x), Math.Abs(y))
    ' geeignetes Epsilon ermitteln
    If mx > 1 Then eps *= mx
    Return Math.Abs(x - y) < eps
  End Function

  '==========================================================
  ' Beispiele für ungeeignete Extensions
  '==========================================================

  ''' <summary>
  ''' Kugel-Oberfläche für einen Radius 
  ''' </summary>
  ''' <param name="radius"></param>
  ''' <returns></returns>
  ''' <remarks></remarks>
  Public Function Sphere(ByVal radius As Double) As Double
    If radius < 0 Then
      Throw New ArgumentException
    End If
    Return Math.PI * 4 * radius * radius
  End Function

  ''' <summary>
  ''' Austausch des Inhalts von x und y
  ''' </summary>
  <Extension()> _
  Public Sub Swap(ByRef x As Double, ByRef y As Double)
    ' Argumente zunächst checken
    x.GetValue() : y.GetValue()
    ' Inhalt austauschen
    Dim z As Double = x
    x = y : y = z
  End Sub

  '=========================================================
  'Routinen zur Verwaltung der modulglobalen Variablen
  '=========================================================

  ''' <summary>
  ''' Routine setzt die Werte-Spannweite
  ''' für die Funktion 'GetValue_Range'
  ''' </summary>
  ''' <param name="MinValue"></param>
  ''' <param name="MaxValue"></param>
  Public Sub SetRange(ByVal MinValue As Double, ByVal MaxValue As Double)
    If MinValue > MaxValue Then
      Throw New ArgumentException
    End If
 
    gMinValue = MinValue
    gMaxValue = MaxValue
    gLimits = True
  End Sub

  ''' <summary>
  ''' Ein gesetzter Bereich zulässiger Werte
  ''' wird gelöscht
  ''' </summary>
  Public Sub ClearRange()
    gLimits = False
    gMinValue = Double.MinValue
    gMaxValue = Double.MaxValue
  End Sub

  ''' <summary>
  ''' Zeitpunkt der letzten Abfrage einer
  ''' Double-Variable über die Extensions
  ''' </summary>
  Public Function GetTime_LastAccess() As String
    Return gTime_LastAccess
  End Function

  ''' <summary>
  ''' Zahl der Abfragen von Double-Variablen
  ''' über die Extensions
  ''' </summary>
  Public Function GetAccess_Counter() As Long
    Return gAccess_Counter
  End Function

  ''' <summary>
  ''' Reinitialisierung des Zugriffs-Zählers
  ''' </summary>
  Public Sub Reset_AccessCounter()
    gAccess_Counter = 0
  End Sub

  ''' <summary>
  ''' Größter und kleinster der bisher abgefragten
  ''' Double-Werte
  ''' </summary>
  ''' <param name="Minimum">Kleinster Wert</param>
  ''' <param name="Maximum">Größter Wert</param>
  Public Sub GetMinMax(Optional ByRef Minimum As Double = 0, _
    Optional ByRef Maximum As Double = 0)
 
    If gMinimum > gMaximum Then
      ' falls noch keine Werte abgefragt 
      ' worden sind
      Throw New InvalidOperationException
    End If
    Minimum = gMinimum
    Maximum = gMaximum
  End Sub

  ''' <summary>
  ''' Zurücksetzen des Ausprägungsregisters
  ''' für die Extreme aller abgefragten Werte
  ''' </summary>
  Public Sub ResetMinMax()
    gMinimum = Double.MaxValue
    gMaximum = Double.MinValue
  End Sub

  ''' <summary>
  ''' Kritische Schranke für die Ausprägung 
  ''' der abgefragten Werte
  ''' </summary>
  ''' <param name="Threshold">Kritische Schranke</param>
  ''' <remarks></remarks>
  Public Sub SetThreshold(ByVal Threshold As Double)
    gThreshold = Threshold
    gThreshold_Counter = 0
  End Sub

  ''' <summary>
  ''' Zahl der Abfragen von Double-Variablen
  ''' über die Extensions, bei denen die 
  ''' kritische Schranke überschritten war
  ''' </summary>
  Public Function GetThreshold_Counter() As Long
    Return gThreshold_Counter
  End Function

  ''' <summary>
  ''' Zahl der Abfragen von Double-Variablen
  ''' über die Extensions, bei denen eine 
  ''' Ausnahme ausgelöst werden mußte
  ''' </summary>
  Public Function GetException_Counter() As Long
    Return gException_Counter
  End Function

  Private Sub Adjust_Globals(ByVal arg As Double)
    ' Anpassung der modul-globalen
    ' Registriervariablen auf die aktuelle Abfrage 
    gTime_LastAccess = Now.ToString
    gAccess_Counter += 1
    If gMaximum < arg Then gMaximum = arg
    If gMinimum > arg Then gMinimum = arg
    If arg > gThreshold Then
      gThreshold_Counter += 1
    End If
  End Sub

End Module

End Namespace