vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Blitzschnelles Erstellen von grafischen Diagrammen!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2017
 
zurück
Rubrik: Verschiedenes   |   VB-Versionen: VB5, VB601.02.03
Interpreter für Mathematische Ausdrücke

Wenn sich eine Berechnungsformel öfter für eine Anwendung ändert, hat man 2 Möglichkeiten: Source suchen, Formel ändern, dem Ganzen einen neuen Namen geben, Kompilieren, Verwirrung beim Benutzer erzeugen. Oder: Einen Interpreter für den Mathematischen Ausdruck schreiben, den Benutzer die Formel in eine Textbox eintragen lassen, Freude erzeugen.

Autor:  Dietmar G. BeyerBewertung:     [ Jetzt bewerten ]Views:  19.303 

Neue Version! sevEingabe 3.0 (für VB6 und VBA)
Das Eingabe-Control der Superlative! Noch besser und noch leistungsfähiger!
Jetzt zum Einführungspreis       - Aktionspreis nur für kurze Zeit gültig -

Wenn sich eine Berechnungsformel öfter für eine Anwendung ändert, hat man 2 Möglichkeiten: Source suchen, Formel ändern, dem Ganzen einen neuen Namen geben, Kompilieren, Verwirrung beim Benutzer erzeugen. Oder: Einen Interpreter für den Mathematischen Ausdruck schreiben, den Benutzer die Formel in eine Textbox eintragen lassen, Freude erzeugen.

Was müssen wir alles berücksichtigen?

  • Fehlerhafte Formeln
  • Doppelte Operatoren (-- ist =+, +-ist -)
  • Division durch 0 geht nicht
  • Punktrechnung geht vor Strichrechnung
  • Klammer-Ebenen

Es soll ja eine natürliche Eingabe möglich sein, nicht das etwas seltsame Verfahren der umgekehrten polnischen Notation (die C++ Leute werden mich jetzt schlagen).

Die Formel soll dann lauten: Ergebnis (auch f(x) genannt)= x^2+(6x+5)*2-sin(x). Jede andere Formel soll so auch interpretiert werden können. Eine Kleinigkeit ist jetzt noch zu machen: Die Klammer bei sin(x) ist zwar eine Klammer, hat aber eine andere Bedeutung. Sie stellt den zu berechnenden Wert für Sinus (Cos, Tan ...) dar. Also einigen wir uns darauf, dass diese Klammer nicht rund, sondern eckig ‚[ ]’sein muss. Also sieht die Formel nun so aus: Ergebnis = x^2+(6x+5)*2-sin[x].

Wie soll das nun funktionieren? Eigentlich ganz einfach, wir bilden einfach nach, was wir in der Schule so gelernt haben (meine alten Mathe-Lehrer wären stolz auf mich). Einfach bei Klammern von innen nach außen lösen, Teil-Ergebnis einsetzen, Teile berechnen, Ergebnis einsetzen, .......

Ein wesentliches Merkmal des Interpreters ist die Rekursion. Wie funktioniert Rekursion? Dabei ruft sich die Funktion selbst wieder auf, um Teilergebnisse zu erhalten:

 

Einige Vorarbeiten sind als erstes zu machen:

Als erstes normieren wir die Formel, dass sie immer gleich behandelt werden kann und die gleichen Ausdrücke verwendet. Damit ist alles in kleinen Buchstaben und wir haben keinen Ärger mit Sin, sIn, SIN ….. Auch die Eingabe von Kommas als Dezimalzeichen, die Ärger machen könnten, sind nun computergerechte Punkte.

Function Norm(Text As String) As String
  ' alles klein
  Text = LCase(Text)
 
  ' alle Kommas zu Punkten machen
  Text = Replace(Text, ",", ".")
 
  ' keine Spaces
  Text = Replace(Text, " ", "")
  Norm = Entferne_PlusMinus(Text)
End Function

Oben haben wir schon das Problem mit Doppel-Operatoren gesehen, also lösen wir es.

Da die Kreativität des Menschen bei der Eingabe fast unbegrenzt ist, das trifft nicht nur die DAU’s, müssen die drei Fälle gelöst werden ++, +-, -+, und --. Doppel-Operatoren können auch nach dem Einsetzen von Teilergebnissen auftreten.

Und wie geht’s?
Wir suchen den Platz, an dem z.B. "--" steht, und ersetzen es dort mit dem (für uns) mathematisch korrekten +. Da so was in einer Formel mehr als einmal vorkommen kann, wird nach der Ersetzung eine Rekursion aufgerufen.

Function Entferne_PlusMinus(ByVal Formel As String) As String
  Dim Platz As Integer
  Dim NewFormel As String
 
  Entferne_PlusMinus = Formel
 
  If InStr(Formel, "++") Then Formel = Replace(Formel, "++", "+")
  If InStr(Formel, "+-") Then Formel = Replace(Formel, "+-", "-")
  If InStr(Formel, "-+") Then Formel = Replace(Formel, "-+", "-")
  If InStr(Formel, "--") Then Formel = Replace(Formel, "--", "+")
 
  Entferne_PlusMinus = Formel  
End Function

Da uns immer mal wieder in Teilergebnissen Kommas statt Punkten begegnen, ersetzt die Funktion RP die Kommas mit Punkten.

Function RP(Text As String) As String
  ' alle Kommas zu Punkten machen
  RP = Replace(Text, ",", ".")
End Function

Die Vorbereitungen sind abgeschlossen.

Arithmetischen Operationen

Jetzt versuchen wir uns an den arithmetischen Operationen als Beispiel für die Interpretation. Das Ergebnis soll formatiert mit 4 Nachkommastellen im String stehen.

Formel ist der zu interpretierende Ausdruck

Das ist der prinzipielle Vorgang am Beispiel der Multiplikation:
(Im Source sind die Operationen für Multiplikation, Division, Potenzierung, Addition und Subtraktion zu einer Funktion „MDHAS“ zusammengefasst)

Function MDHPM(ByVal Formel As String, Operator As String) As String
  ' Stelle an der das Zeichen gefunden wurde : hier ein * oder /
  Dim Platz As Integer
  ' Variable zu Vorwärts/Rückwärtslaufen im String
  Dim X As Integer
  ' Zähler
  Dim Y As Integer
  ' Welche Zahl steht vor dem Zeichen ?
  Dim vorne As String
  ' Welche Zahl steht nach dem Zeichen ?
  Dim hinten As String
  ' Neue Formel nach einer Teil-Lösung
  Dim NewFormel As String
  ' Speichern des alten Strings
  Dim AltStr As String
  ' Die jeweils anderen Operatoren
  Dim AlleOperatoren As String
  Dim gefunden As Boolean
  Dim i As Integer
  Dim NotFund As Boolean
  Dim AltStr_Hinten As String
 
  AlleOperatoren = "+-*/^"
 
  ' Erst mal sicherstellen, dass keine Doppel-Operatoren da sind.
  Formel = Norm(Formel)
  If InStr(Formel, "e") Then Exit Function  ' wegen 2.0000056e-3
 
  ' Für den Fall, dass keine Operation angefordert ist 
  MDHPM = Formel
 
  If FindOperator(Mid(Formel, 2), AlleOperatoren) = 0 Then
    MDHPM = Formel
    Exit Function
  End If  
 
  ' wo seht der Operator
  Platz = InStr(1, Formel, Operator)
  If Platz > 0 Then
    Y = 0
    X = Platz
    ' wandere zurück, um die Zahl vor dem Operator zu finden
    Do
      Y = Y + 1
      X = X - 1
      If X = 0 Then
        ' für den Fall, dass wir am Anfang gelandet sind
        vorne = Mid(Formel, X + 1, Y - 1)
        Exit Do
      End If
 
      If FindOperator(Mid(Formel, X, 1), AlleOperatoren) > 0 Then
        If Y = 1 Then        
          If InStr(Mid(Formel, X, 1), "+") Then
            ' nötig wg. -22*+12
            vorne = Mid(Formel, X, Y)
            Exit Do
          End If
          If InStr(Mid(Formel, X, 1), "-") Then
            ' nötig wg. -22*+12
            vorne = Mid(Formel, X, Y)
            Exit Do
          End If
        End If
        vorne = Mid(Formel, X + 1, Y)
        Exit Do
      End If         
    Loop
    AltStr = Left(Formel, X)
 
    ' Nun das Ganze vorwärts:
    Y = 0
    X = Platz + 1
    Do
      Y = Y + 1
      ' X = X + 1
 
      If Y > Len(Formel) Then
        hinten = Mid(Formel, X)
        AltStr_Hinten = ""
        Exit Do
      End If
 
      If FindOperator(Mid(Formel, X, 1), AlleOperatoren) > 0 Then
        ' (InStr(Mid(Formel, X, 1), AlleOperatoren) > 0 Then
        hinten = Mid(Formel, X, Y)
        AltStr_Hinten = Mid(Formel, X + Y)
        Exit Do
      End If          
    Loop
 
    ' Das wiederum so lange machen, bis wir die Zahl hinter
    ' dem Operator gefunden haben, oder das Ende erreicht ist.
    ' So wird jetzt unsere neue Formel berechnet ausschauen:
 
    If AltStr = "-" Then
      AltStr = ""
      vorne = "-" + vorne
    End If
    If AltStr = "+" Then
      AltStr = ""
      vorne = "+" + vorne
    End If
 
    Select Case Operator
      Case "*"
        NewFormel = AltStr & CStr((Val(vorne) * Val(hinten))) & AltStr_Hinten
        If InStr(1, NewFormel, "*") > 0 Then
          ' Die Rekursion aufrufen, da noch weitere Multiplikation zu machen sind
          NewFormel = MDHPM(NewFormel, Operator)
        End If
 
      Case "/"
        NewFormel = AltStr & CStr((Val(vorne) / Val(hinten))) & AltStr_Hinten
        If Err.Number = 11 Then
          ' Division durch 0 ist nicht möglich
          MDHPM = "unmöglich"
          Exit Function
        End If
 
        If InStr(1, NewFormel, "/") > 0 Then
          ' Die Rekursion aufrufen, da noch weitere Divisionen zu machen sind
          NewFormel = MDHPM(NewFormel, Operator)
        End If
 
      Case "^"
        NewFormel = AltStr & CStr((Val(vorne) ^ Val(hinten))) & AltStr_Hinten
        If InStr(1, NewFormel, "^") > 0 Then
          ' Die Rekursion aufrufen, da noch weitere Potenzierungen zu machen sind
          NewFormel = MDHPM(NewFormel, Operator)
        End If
 
      Case "+"
        NewFormel = AltStr & CStr((Val(vorne) + Val(hinten))) & AltStr_Hinten
        If InStr(1, NewFormel, "+") > 0 Then
          ' Die Rekursion aufrufen, da noch weitere Additionen zu machen sind
          NewFormel = MDHPM(NewFormel, Operator)
        End If
 
      Case "-"
        NewFormel = AltStr & CStr((Val(vorne) - Val(hinten))) & AltStr_Hinten
        If InStr(1, NewFormel, "-") > 0 Then
          ' Die Rekursion aufrufen, da noch weitere Subtraktionen zu machen sind
          NewFormel = MDHPM(NewFormel, Operator)
        End If
 
    End Select
    ' und fertig
    MDHPM = CStr(NewFormel)
    MDHPM = RP(Format(Replace(NewFormel, ".", ","), "0.0000"))    
  End If
End Function

Jetzt können wir Multiplizieren. Das Addieren und Subtrahieren geht genau auf die gleiche Art.

Interpreter für die vier Grundrechenarten

Beim Dividieren haben wir eine Falle zu beachten, die uns die Division durch 0 stellt. Da das nun mal nicht geht, muss dann eine Fehlermeldung her.

......
  Case "/"
    NewFormel = AltStr & CStr(CDbl(Val(vorne) / Val(hinten))) & Mid(Formel, X)
    ' Division durch 0 ist nicht möglich
    If Err.Number = 11 Then
      MDHPM = "unmöglich"
      Exit Function
    End If
......

Vom Prinzip her sind nun die vier Grundrechenarten verfügbar und wir könnten eine aufrufende Funktion schreiben:

Public Function Mathe_Interpreter(ByVal Formel As String) As String
  Formel = Norm(Formel)
 
  ' Berechne und entferne cos[ ],sin[ ],tan[ ]und atn[ ]
  If InStr(1, Formel, "[") > 0 Then Formel = CSTA(Formel)
 
  ' Berechne den Klammerinhalt und entferne die Klammer
  If InStr(1, Formel, "(") > 0 Then Formel = Klammer(Formel)
 
  ' Berechne und entferne ^
  If InStr(1, Formel, "^") > 0 Then Formel = MDHPM(Formel, "^")
  ' Berechne und entferne *
  If InStr(1, Formel, "*") > 0 Then Formel = MDHPM(Formel, "*")
  ' Berechne und entferne /
  If InStr(1, Formel, "/") > 0 Then Formel = MDHPM(Formel, "/")
  If Formel = "unmöglich" Then
    ' Bei Division Durch 0
    ' Fehler erzeugen
    Err.Raise 11
    Exit Function
  End If
  ' Berechne und entferne +
  If InStr(1, Formel, "+") > 0 Then Formel = MDHPM(Formel, "+")
  ' Berechne und entferne -
  If InStr(2, Formel, "-") > 0 Then Formel = MDHPM(Formel, "-")
  Formel = Norm(Formel)
 
  ' Und fertig !
  Mathe_Interpreter = Formel
End Function

Die Reihenfolge ergibt sich aus der Regel Punktrechnung geht vor Strichrechnung. Gut und schön, das funktioniert! Aber manchmal muss man doch Klammern setzen, um „5-2*3“ als „(5-2)*3“ zu beschreiben. Ist ja ein Unterschied ob das Ergebnis -1 oder 9 ist.

Die Art, die Formel zu durchsuchen, kennen wir ja schon, passen wir die Sache einfach an:

Function Klammer(ByVal Formel As String) As String
  Dim Platz As Integer
  Dim Y As Integer
  Dim X As Integer
  Dim VorneStr As String
  ' der ist neu, da das zu berechnende Teil 
  ' zwischen 2 Klammern steht
  Dim MittelStr As String
  Dim NeuFormel As String
 
  ' Die Doppelten wieder weg
  Formel = Norm(Formel)
 
  ' aus Sicherheit, wenn es keine Klammer gibt
  Klammer = Formel
  Platz = InStr(1, Formel, ")")
  If Platz > 0 Then
    Y = 0
    X = Platz
    Do
      ' das Innere der Klammer suchen
      Y = Y + 1
      X = X - 1
      If X = 0 Then Exit Do
      If Mid(Formel, X, 1) <> "(" Then
        MittelStr = Mid(Formel, X, Y)
      End If
    Loop Until Mid(Formel, X, 1) = "("
    VorneStr = ""
    If X > 0 Then VorneStr = Mid(Formel, 1, X - 1)
    ' die Hauptfunktion rekursiv aufrufen damit der innere Teil 
    ' der Funktion interpretiert wird
    NeuFormel = VorneStr & Mathe_Interpreter(MittelStr) & Mid(Formel, Platz + 1)
 
    If InStr(1, Formel, ")") > 0 Then
      ' Wieder in die Rekursion für mehr Klammern
      NeuFormel = Klammer(NeuFormel)
    End If
    Klammer = RP(Format(NeuFormel, "0,0000"))
  End If
End Function

Hier haben wir ein schönes Beispiel für die Rekursion, da in dem Ausdruck NewFormel = BeforeStr & Mathe_Interpreter (MiddleStr) & Mid(Formel, Platz + 1) unsere Hauptfunktion aufgefordert wird, den Klammerinhalt zu berechnen. So wird der Klammer-Salat langsam von innen nach außen, wie es sich gehört,aufgelöst.

Nun kann man es schon besser gebrauchen.

Trigonometrischen Funktionen

Die einfachen trigonometrischen Funktionen cos, sin, tan, und atn (Arcus-Tangens, da war doch was? ), kurz CSTA, haben wir am Anfang schon als einen Sonderfall gesehen. Da müssen die Klammern anders aussehen. Sie müssen in eckigen Klammern stehen. Nur so können wir mit vertretbarem Aufwand sicher das Argument in der Klammer identifizieren.

Public Function CSTA(ByVal Formel As String) As String
  Dim Platz As Integer
  Dim Y As Integer
  Dim X As Integer
  Dim VorneStr As String
  Dim MittelStr As String
  Dim NeuFormel As String
  Dim XType As String
 
  Formel = Norm(Formel)
  CSTA = Formel
  Platz = InStr(1, Formel, "]")
  If Platz > 0 Then
    Y = 0
    X = Platz
    Do
      ' suche das Innere der Klammer
      Y = Y + 1
      X = X - 1
      If X = 0 Then Exit Do '
      If Mid(Formel, X, 1) <> "[" Then
        MittelStr = Mid(Formel, X, Y)
      End If
    Loop Until Mid(Formel, X, 1) = "["
    VorneStr = "" '
    If X > 0 Then VorneStr = Mid(Formel, 1, X - 4)
    If X > 0 Then XType = Mid(Formel, X - 3, 3)
 
    Select Case XType
      Case "cos"
        NeuFormel = VorneStr & CStr(Cos(Format(MittelStr, "0.0000"))) & _
         Mid(Formel, Platz + 1)
      Case "sin"
        NeuFormel = VorneStr & CStr(Sin(Format(MittelStr, "0.0000"))) & _
          Mid(Formel, Platz + 1)
      Case "tan"
        NeuFormel = VorneStr & CStr(Tan(Format(MittelStr, "0.0000"))) & _
          Mid(Formel, Platz + 1)
      Case "atn"
        NeuFormel = VorneStr & CStr(Atn(Format(MittelStr, "0.0000"))) & _
          Mid(Formel, Platz + 1)
    End Select
 
    If InStr(1, NeuFormel, "]") > 0 Then
      ' und ab in die Rekursion
      NeuFormel = CSTA(NeuFormel)
    End If
    CSTA = RP(Format(NeuFormel, "0.0000"))
  End If
End Function

Wie man die übrigen trigonometrischen Funktionen berechnet hab ich mal im Anhang zusammengefasst. Wer will, kann sie ja einbauen.

Sonstige mathematische Funktionen

Wurzelziehen:
Kann man wie die Multiplikation implementieren, muss aber darauf achten (siehe Division), dass das Argument nicht 0 oder kleiner ist.

Logarithmen:
Wer die Beschreibung der Log Funktion aufmerksam liest, der wird feststellen, das damit eigentlich mathematisch LN, der Logarithmus zu Basis e (Euler-Zahl , wie Pi eine unendliche Zahl, ungefähr 2,718282) gemeint ist.
Der Zusammenhang zwischen Logarithmen zur Basis e und Logarithmen zur Basis 10, die, mit denen wir in der Schule zu tun hatten ist:

Static Function Log10(X as dbl) as dbl
   Log10 = Log(X) / Log(10#)
End Function

oder allgemeiner für eine beliebige Basis

Static Function LogB(X as dbl, Basis as dbl) as dbl
   Logb = Log(X) / Log(Basis)
End Function

Die Exp-Funktion stellt die Umkehrfunktion zur Log-Funktion dar und wird manchmal als Anti-Logarithmus bezeichnet.

Bei der Implementation ist darauf zu achten, dass der Wert > 709,782712893 einen Fehler verursacht.

Rundungs-Funktionen:
    ABS(), FIX() , INT() und SGN(), kurz AFIS
    Werden wie Cos(), Sin(), Tan() und Atn() implementiert.

Nun die entscheidende Frage: Wie rufe ich das auf? Was fange ich damit an? Wo ist der Nährwert?

Aufruf mit

On Error Resume Next
Dim X As Double 
X = Mathe_Interpreter ("2+3*4^2*2*cos[3]+2") 
If Err.Number = 11 Then MsgBox "Division durch 0", , "nicht lösbar"
If Err.Number = vbObjectError + 555 Then 
  MsgBox "Formel Struktur nicht erlaubt oder fehlerhaft", , "Fehlerhafte Gleichung" 
End if
On error goto 0

Weitergehen ist dann möglich bei einer Formel
Formel = „x^2+(6x+5)*2-sin[x]“

Dim i as long
Dim X as dbl
On Error Resume Next
 
For i=1 to 22
  X= Mathe_Interpreter (replace(Formel, x, cstr(i)))
 If Err.Number = 11 Then MsgBox "Division durch 0", , "nicht lösbar"
 If Err.Number = vbObjectError + 555 Then 
   MsgBox "Formel Struktur nicht erlaubt oder fehlerhaft", , "Fehlerhafte Gleichung" 
 End if
Next
On error goto 0

Anhang

Abgeleitete trigonometrische Funktionen:

Funktion  Abgeleitete Äquivalenten
Sekans Sekans(X) = 1 / Cos(X)
Kosekans  Kosekans(X) = 1 / Sin(X)
Kotangens Kotangens(X) = 1 / Tan(X)
Arkussinus Arkussinus(X) = Atn(X / Sqr(-X * X + 1))
Arkuskosinus Arkuskosinus(X) = Atn(-X / Sqr(-X * X + 1)) + 2 * Atn(1)
Arkussekans Arkussekans(X) = Atn(X / Sqr(X * X – 1)) + Sgn((X) – 1) * (2 * Atn(1))
ArkuskosekansArkuskosekans(X) = Atn(X / Sqr(X * X - 1)) + (Sgn(X) - 1) * (2 * Atn(1))
Arkuskotangens Arkuskotangens(X) = Atn(X) + 2 * Atn(1)
Hyperb. SinusHSin(X) = (Exp(X) – Exp(-X)) / 2 
Hyperb. KosinusHCos(X) = (Exp(X) + Exp(-X)) / 2
Hyperb. TangensHTan(X) = (Exp(X) – Exp(-X)) / (Exp(X) + Exp(-X))
Hyperb. SekansHSekans(X) = 2 / (Exp(X) + Exp(-X))
Hyperb. KosekansHKosekans(X) = 2 / (Exp(X) – Exp(-X))
Hyperb. KotangensHKotangens(X) = (Exp(X) + Exp(-X)) / (Exp(X) – Exp(-X))
Hyperb. ArkussinusHArkussinus(X) = Log(X + Sqr(X * X + 1))
Hyperb. ArkuskosinusHArkuskosinus(X) = Log(X + Sqr(X * X - 1))
Hyperb. ArkustangensHArkustangens(X) = Log((1 + X) / (1 – X)) / 2
Hyperb. ArkussekansHArkussekans(X) = Log((Sqr(-X * X + 1) + 1) / X)
Hyperb. ArkuskosekansHArkuskosekans(X) = Log((Sgn(X) * Sqr(X * X + 1) + 1) / X)
Hyperb. ArkuskotangensHArkuskotangens(X) = Log((X + 1) / (X – 1)) / 2

Dieser Workshop wurde bereits 19.303 mal aufgerufen.

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

Aktuelle Diskussion anzeigen (5 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Workshops finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

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-2017 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