PureBoard

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
            ElseIf FindString(Ausdruck,"cos",c)=c:\pri=pri+20:\operator=#_cos:c+2
            ElseIf FindString(Ausdruck,"tan",c)=c:\pri=pri+20:\operator=#_tan:c+2          
            ElseIf FindString(Ausdruck,"sqrt",c)=c:\pri=pri+20:\operator=#_sqrt:c+3
            ElseIf FindString(Ausdruck,"sqr",c)=c:\pri=pri+20:\operator=#_sqr:c+2
            ElseIf FindString(Ausdruck,"cube",c)=c:\pri=pri+20:\operator=#_cube:c+3
            Else
              MessageRequester("Unbekannter Ausdruck:",Right(ausdruck,Len(Ausdruck)-c+1))
              End 
            EndIf
        EndSelect      
      EndIf   
    Next
    ;letzten Operanden anhängen
    AddElement(TermListe())
    \operand=ValD(term)
    \pri=-1
    term=""
    
    ;Liste gültig ?
    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)       
      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("33*(12+9)")  ;=693
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