Formelparser

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
bizzl
Beiträge: 82
Registriert: 08.09.2005 18:07
Computerausstattung: AMD Athlon II X4 635
Windows 7 64 Bit
Wohnort: Nordhessen - früher : Südniedersachsen

Formelparser

Beitrag von bizzl »

Hallo,
ich hatte heute Langeweile und habe zum Zeitvertreib einen Formelparser geschrieben.
Er beherrscht Punkt- vor Strichrechnung und Funktionen wie sin,cos,sqr,sqrt u.s.w.
Funktioniert zur Zeit nur im Debugmodus (habe jetzt keine Zeit mehr, ein GUI drum zu basteln :cry: ).

Seht ihn euch an und viel Spaß damit. (Ist noch nicht sehr gut kommentiert :oops: )

Code: Alles auswählen

EnableExplicit

Enumeration 1
  #_plus
  #_minus
  #_mal
  #_teil
  #_sin
  #_cos
  #_tan
  #_sqr
  #_sqrt
  #_cube
EndEnumeration

Structure sTermListe ;hier wird der übergebene Ausdruck gespeichert
  pri.i
  StructureUnion
    operand.d
    operator.i
  EndStructureUnion
  
  ;In der StructureUnion steht entweder ein Operator (#_plus,#_minus usw.), 
  ;   dann steht in "pri" seine Priorität,
  ;oder ein Operand, dann steht in "pri" -1
EndStructure

Procedure.d Rechnen(Ausdruck.s)
  Protected NewList TermListe.sTermListe() ;hier stehen die zerlegten Teilausdrücke
  Protected c,pri,index
  Protected.s m,term
  Protected.d l,r
  
  ;"Ausdruck" "normalisieren"
  Ausdruck=LCase(Ausdruck)  ;in Kleinbuchstaben wandeln
  Ausdruck=RemoveString(Ausdruck," ") ;Leerzeichen und...
  Ausdruck=RemoveString(Ausdruck,Chr(9))  ;... Tabs löschen
  Ausdruck=ReplaceString(Ausdruck,",",".")  ;Kommata in Dezimalpunkte umwandeln
  ;In "Ausdruck" steht jetzt der "normalisierte" "Ausdruck"
  
  ;"Ausdruck" zerlegen
  With TermListe()
    For c=1 To Len(Ausdruck)
      m=Mid(Ausdruck,c,1) ;Zeichen für Zeichen holen
      If m="(":pri+100:Continue:EndIf  ;runde Klammer auf -> Priorität rauf
      If m=")":pri-100:Continue:EndIf  ;runde Klammer zu  -> Priorität wieder runter
      If m="-" And term="":term="-":Continue:EndIf ;negative Zahl?
      If (m>="0" And m<="9") Or m="." ;Ziffer oder Dezimalpunkt ?
        term+m  ;Zahl "zusammenbauen"
      Else  ;Rechenzeichen ?
        AddElement(TermListe())
        \operand=ValD(term)
        \pri=-1
        term=""
        AddElement(TermListe()) ;Operatoren eintragen
        Select m
          Case "+":\pri=pri+10:\operator=#_plus
          Case "-":\pri=pri+10:\operator=#_minus
          Case "*":\pri=pri+11:\operator=#_mal
          Case "/":\pri=pri+11:\operator=#_teil
          Default
            If FindString(Ausdruck,"sin",c)=c:\pri=pri+20:\operator=#_sin:c+2:EndIf
            If FindString(Ausdruck,"cos",c)=c:\pri=pri+20:\operator=#_cos:c+2:EndIf
            If FindString(Ausdruck,"tan",c)=c:\pri=pri+20:\operator=#_tan:c+2:EndIf          
            If FindString(Ausdruck,"sqrt",c)=c:\pri=pri+20:\operator=#_sqrt:c+3:EndIf
            If FindString(Ausdruck,"sqr",c)=c:\pri=pri+20:\operator=#_sqr:c+2:EndIf
            If FindString(Ausdruck,"cube",c)=c:\pri=pri+20:\operator=#_cube:c+3:EndIf
        EndSelect      
      EndIf   
    Next
    ;letzten Operanden anhängen
    AddElement(TermListe())
    \operand=ValD(term)
    \pri=-1
    term=""
    
    ;Liste gültig ?                                          <--- geändert 
    If ListSize(TermListe())=1
      FirstElement(TermListe())
      ProcedureReturn \operand
    EndIf

    ;Liste nach der jeweils höchsten Priorität durchsuchen und Teilausdruck berechnen
    Repeat
      pri=0
      ForEach TermListe()
        If \pri>pri
          pri=\pri
          index=ListIndex(TermListe())
        EndIf
      Next
      SelectElement(TermListe(),index)  ;<- Der Teilausdruck mit der höchsten Priorität
      PreviousElement(TermListe()) ;linken Operanden holen...
      l=\operand
      DeleteElement(TermListe())  ;... und aus der Liste löschen
      NextElement(TermListe()):NextElement(TermListe()) ;rechten Operanden holen...
      r=\operand
      DeleteElement(TermListe())  ;... und aus der Liste löschen 
      \pri=-1
      Select \operator  ;Ergebnis des Teilausdrucks berechnen und anstelle des Operators speichern
        Case #_plus:\operand=l+r
        Case #_minus:\operand=l-r
        Case #_mal:\operand=l*r
        Case #_teil
          If r=0:MessageRequester("Fehler !","Division durch 0 !"):ProcedureReturn NaN() :EndIf
          \operand=l/r    
        Case #_sin:\operand=Sin(Radian(r))
        Case #_cos:\operand=Cos(Radian(r))
        Case #_tan:\operand=Tan(Radian(r))  
        Case #_sqr:\operand=Pow(r,2)  ; SQuaRe 
        Case #_sqrt
          If r<0:MessageRequester("Fehler !","Quadratwurzel einer negativen Zahl !"):ProcedureReturn NaN() :EndIf
          \operand=Sqr(r)   ; SQuareRooT
        Case #_cube:\operand=Pow(r,3)
        Default
          MessageRequester("Fehler !","Unbekannter Operator !")
          End
      EndSelect
    Until ListSize(TermListe())=1
    ProcedureReturn \operand
  EndWith
EndProcedure

Debug Rechnen("3 +4*1   2,        5* s i  N(45)+456") ;sollte 494.35533905932738 rauskommen
Debug Rechnen("33*12+9")  ;=405
Debug Rechnen("1/2")      ;=0.5
Debug Rechnen("sqr(4)+sqrt(16)")  ;=20
Debug Rechnen("sqrt(4)+sqr(16)")  ;=258
Debug Rechnen("sqrt(9,56")  ;=3.0919249667480613
Debug Rechnen("sqr(122.789")  ;=15077.138521000001
Debug Rechnen("sqrt(16+9)") ;=5
Debug Rechnen("cube(9)")    ;=729
Debug Rechnen("99/(10-8-2)")  ;Fehler:Division durch 0
Debug Rechnen("sqrt(-100)")   ;Fehler:Quadratwurzel einer negativen Zahl

Zuletzt geändert von bizzl am 08.04.2013 07:34, insgesamt 2-mal geändert.
Benutzeravatar
STARGÅTE
Kommando SG1
Beiträge: 7032
Registriert: 01.11.2005 13:34
Wohnort: Glienicke
Kontaktdaten:

Re: Formelparser

Beitrag von STARGÅTE »

Nett, hier allerdings einen kleine Fehler:
  • Er kommt nicht mit einzelnen Zahlen klar:

    Code: Alles auswählen

    Rechnen("-2")
    Rechnen("1.3")
PB 6.01 ― Win 10, 21H2 ― Ryzen 9 3900X, 32 GB ― NVIDIA GeForce RTX 3080 ― Vivaldi 6.0 ― www.unionbytes.de
Aktuelles Projekt: Lizard - Skriptsprache für symbolische Berechnungen und mehr
bizzl
Beiträge: 82
Registriert: 08.09.2005 18:07
Computerausstattung: AMD Athlon II X4 635
Windows 7 64 Bit
Wohnort: Nordhessen - früher : Südniedersachsen

Re: Formelparser

Beitrag von bizzl »

Hab's geändert.
Antworten