Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Mathematik

Parser für algebraische Ausdrücke (expression parser)

Lizenz:Erster Autor:Letzte Bearbeitung:
MIT-LizenzRedakteurnemored 26.10.2013

Der Parser wertet Rechenausdrücke in infix-Notation aus. Er unterstützt die üblichen Rechenoperationen +, -, *, /, \ und ^ sowie geklammerte Ausdrücke, außerdem eine Reihe von FreeBASIC-interne Funktionen (sin, cos, tan, asin, acos, atn und atan, abs, sgn, sqr, exp, log und ln, int, cint, fix, frac) und das Anlegen und Verwenden eigener Variablen.

Auftretende Fehler werden in den Variablen Calculate.CalcError (Fehlernummer) und Calculate.CalcErrorTerm (fehlerhafter Termabschnitt) festgehalten. Calculate.CalcErrorTerm enthält jedoch ggf. bereits einen zum Teil ausgewerteten Term.

Achtung: Sämtliche Rechenzeichen (insb. bei der Multiplikation) sind erforderlich. Siehe dazu auch das letzte Beispiel auf dieser Seite.

Update 26.10.2013:

' Version 2013-10-26

namespace Calculate
  enum Errors
    NoError = 0
    ErrorNoValue
    ErrorMissingBrace
    ErrorMissingNumber
    ErrorWrongDecimalPoint
    ErrorWrongExponent
    ErrorIllegalSymbol
    ErrorNotANumber
    ErrorUndefinedFunction
    ErrorUndefinedVariable
    ErrorOverwriteFunction
    ErrorIllegalValue
  end enum

  type variables
    as string id
    as double value
    declare constructor
    declare constructor(i as string, v as double)
  end type
  constructor variables
  end constructor
  constructor variables(i as string = "", v as double = 0)
    this.id    = i
    this.value = v
  end constructor

  dim shared as variables globalVar(), localVar()
  dim shared as Errors CalcError
  dim shared as string CalcErrorTerm
  const NaN = -sqr(-1)
end namespace

declare function calc(t as string) as double
declare function calcPart(t as string) as double
declare function calcFunction(func as string, value as string) as double
declare function calcGetVar(variable as string) as double
declare function calcSetVar overload (variable as string, value as string) as double
declare sub calcSetVar(variable as string, value as double)

' vordefinierte Konstanten
calcSetVar "e",  2.718281828459045
calcSetVar "pi", 3.141592653589793

function calc(t as string) as double
  dim as string term
  dim as integer seperator = 0, lastSeperator, position = 0, newposition = 0
  dim as double value
  erase Calculate.localVar
  Calculate.CalcError = 0
  Calculate.CalcErrorTerm = ""
  do
    lastSeperator = seperator
    seperator = instr(seperator+1, t, ";")
    if seperator then
      term = lcase(trim(mid(t, lastSeperator+1, seperator-lastSeperator-1), any chr(9, 32)))
    else
      term = lcase(trim(mid(t, lastSeperator+1), any chr(9, 32)))
    end if
    if term = "" then
      Calculate.CalcError = Calculate.ErrorNoValue
      return Calculate.NaN
    end if
    ' Setzen von Variablen pruefen
    if term[0] > 96 and term[0] < 123 then
      do while position < len(term)
        select case term[position]
          case 97 to 122
            position += 1
          case 9, 32
            if newposition = 0 then newposition = position
            position += 1
          case 61          ' =
            if newposition = 0 then newposition = position
            value = calcSetVar(left(term, newposition), mid(term, position+2))
            continue do, do
          case else
            exit do
        end select
      loop
    end if
    value = calcPart(term)
    if Calculate.CalcError then return Calculate.NaN
  loop until seperator = 0
  return value
end function

function calcPart(t as string) as double
  dim as string term = trim(t, any chr(9, 32))
  dim as double tempValue, tempValue2
  if term = ""  then
    Calculate.CalcError = Calculate.ErrorNoValue
    return Calculate.NaN
  end if
  dim as integer position = 0, newposition = 0, count = 0, lastChar = 0

  ' Klammern abtrennen
  do while position < len(term)
    select case term[position]
      case 97 to 122
        if lastChar = 0 then lastChar = position+1
      case 9, 32
        ' nothing to do ...
      case 40            ' (
        count = 1
        newposition = position+1
        do while newposition < len(term)
          select case term[newposition]
            case 40      ' (
              count += 1
            case 41      ' )
              count -= 1
              if count = 0 then exit do
          end select
          newposition += 1
        loop
        if count > 0 then
          Calculate.CalcError = Calculate.ErrorMissingBrace
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        if lastChar then
          term = left(term, lastChar-1) _
                 & calcFunction(mid(term, lastChar, position-lastChar+1), mid(term, position+2, newposition-position-1)) _
                 & mid(term, newposition+2)
        else
          tempValue = calcPart(mid(term, position+2, newposition-position-1))
          if Calculate.CalcError then return Calculate.NaN
          term = left(term, position) & tempValue & mid(term, newposition+2)
        end if
      case else
        lastChar = 0
    end select
    position += 1
  loop

  ' Variablen pruefen
  if term = "+" or term = "-" then                     ' sicherstellen, dass +/- nicht allein steht
    Calculate.CalcError = Calculate.ErrorIllegalSymbol
    Calculate.CalcErrorTerm = term
  end if
  tempValue = iif(term[0] = 43 or term[0] = 45, 2, 1)  ' Vorzeichen?
  position = tempValue
  if term[position-1] > 96 and term[position-1] < 123 then
    do while position < len(term)
      select case term[position]
        case 97 to 122
          position += 1
          continue do
        case 9, 32, 42, 43, 45, 47, 92, 94             ' Trennzeichen
          exit do
        case else
          Calculate.CalcError = Calculate.ErrorIllegalSymbol
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
      end select
      position += 1
    loop
    tempValue = calcGetVar(mid(term, tempValue, position-tempValue+1))
    if Calculate.CalcError then return Calculate.NaN
    if term[0] = 45 then tempValue = -tempValue
    term =  tempValue & mid(term, position+1)
  end if

  ' Strichrechnung trennen
  position = 1
  dim as integer lastSymbol = term[0]
  do while position < len(term)
    select case lastSymbol
      case 42, 47, 92, 94  ' *, /, \, ^
        lastSymbol = term[position]
        position += 1
        continue do      ' Es handelt sich um ein Vorzeichen
    end select
    select case term[position]
      case 43            ' +
        if position > 1 andalso (term[position-1] = 69 or term[position-1] = 101) _
           andalso (term[position-2] > 47 and term[position-2] < 58) then position += 1 : continue do
        if lastSymbol = 43 or lastSymbol = 45 then
          Calculate.CalcError = Calculate.ErrorIllegalSymbol
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart(mid(term, position+2))
        if Calculate.CalcError then return Calculate.NaN
        return tempValue + tempValue2
      case 45            ' -
        if position > 1 andalso (term[position-1] = 69 or term[position-1] = 101) _
           andalso (term[position-2] > 47 and term[position-2] < 58) then position += 1 : continue do
        if lastSymbol = 43 or lastSymbol = 45 then
          Calculate.CalcError = Calculate.ErrorIllegalSymbol
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart("-" & trim(mid(term, position+2), any chr(9, 32)))
        if Calculate.CalcError then return Calculate.NaN
        return tempValue + tempValue2
    end select
    lastSymbol = term[position]
    position += 1
  loop

  ' Punktrechnung trennen
  position = 1
  do while position < len(term)
    select case term[position]
      case 42            ' *
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart(mid(term, position+2))
        if Calculate.CalcError then return Calculate.NaN
        return tempValue * tempValue2
      case 47            ' /
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart(mid(term, position+2))
        if Calculate.CalcError then return Calculate.NaN
        if tempValue2 = 0 then
          Calculate.CalcError = Calculate.ErrorIllegalValue
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        return tempValue / tempValue2
      case 92            ' \
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart(mid(term, position+2))
        if Calculate.CalcError then return Calculate.NaN
        if tempValue2 = 0 then
          Calculate.CalcError = Calculate.ErrorIllegalValue
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        return tempValue \ tempValue2
    end select
    position += 1
  loop

  ' Potenzrechnung trennen
  position = 1
  do while position < len(term)
    select case term[position]
      case 94            ' ^
        tempValue  = calcPart(left(term, position))
        if Calculate.CalcError then return Calculate.NaN
        tempValue2 = calcPart(mid(term, position+2))
        if Calculate.CalcError then return Calculate.NaN
        return tempValue ^ tempValue2
    end select
    position += 1
  loop

  ' Zahlenwert parsen
  dim as integer sign = 1, decpoint = 0, exponent = 0
  if term[0] = 45 then
    if len(term) = 1 then
      Calculate.CalcError = Calculate.ErrorMissingNumber
      Calculate.CalcErrorTerm = term
      return Calculate.NaN
    end if
    sign = -1
    position = 1
  else
    position = 0
  end if
  do while position < len(term)
    select case term[position]
      case 48 to 57      ' 0 - 9
        position += 1
        continue do
      case 46            ' .
        if decpoint or exponent then
          Calculate.CalcError = Calculate.ErrorWrongDecimalPoint
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        decpoint = -1
      case 69, 101       ' e, E
        if exponent orelse position = len(term)-1 then
          Calculate.CalcError = Calculate.ErrorWrongExponent
          Calculate.CalcErrorTerm = term
          return Calculate.NaN
        end if
        position += 1
        select case term[position]
          case 48 to 57  ' 0 - 9
            position += 1
            continue do
          case 43, 45
            if position = len(term)-1 then
              Calculate.CalcError = Calculate.ErrorWrongExponent
              Calculate.CalcErrorTerm = term
              return Calculate.NaN
            end if
            if term[position+1] < 48 or term[position+1] > 57 then
              Calculate.CalcError = Calculate.ErrorWrongExponent
              Calculate.CalcErrorTerm = term
              return Calculate.NaN
            end if
            position += 2
          case else
            Calculate.CalcError = Calculate.ErrorWrongExponent
            Calculate.CalcErrorTerm = term
            return Calculate.NaN
        end select
        exponent = -1
      case else
        Calculate.CalcError = Calculate.ErrorNotANumber
        Calculate.CalcErrorTerm = mid(term, position+1)
        return Calculate.NaN
    end select
    position += 1
  loop
  return val(term)
end function

function calcFunction(func as string, value as string) as double
  dim as double v = calcPart(value)
  if Calculate.CalcError then return Calculate.NaN
  select case func
    case "sin"
      return sin(v)
    case "cos"
      return cos(v)
    case "tan"
      return tan(v)
    case "asin"
      if v < -1 or v > 1 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "asin(" & v & ")"
        return Calculate.NaN
      end if
      return asin(v)
    case "acos"
      if v < -1 or v > 1 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "acos(" & v & ")"
        return Calculate.NaN
      end if
      return acos(v)
    case "atan", "atn"
      return atn(v)
    case "abs"
      return abs(v)
    case "sgn"
      return sgn(v)
    case "sqr"
      if v < 0 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = "sqr(" & v & ")"
        return Calculate.NaN
      end if
      return sqr(v)
    case "exp"
      return exp(v)
    case "log", "ln"
      if v <= 0 then
        Calculate.CalcError = Calculate.ErrorIllegalValue
        Calculate.CalcErrorTerm = func & "(" & v & ")"
        return Calculate.NaN
      end if
      return log(v)
    case "int"
      return int(v)
    case "cint"
      return cint(v)
    case "fix"
      return fix(v)
    case "frac"
      return frac(v)
  end select
  Calculate.CalcError = Calculate.ErrorUndefinedFunction
  Calculate.CalcErrorTerm = func
  return Calculate.NaN
end function

function calcGetVar(variable as string) as double
  for i as integer = 0 to ubound(Calculate.localVar)
    if Calculate.localVar(i).id = variable then return Calculate.localVar(i).value
  next
  for i as integer = 0 to ubound(Calculate.globalVar)
    if Calculate.globalVar(i).id = variable then return Calculate.globalVar(i).value
  next
  Calculate.CalcError = Calculate.ErrorUndefinedVariable
  Calculate.CalcErrorTerm = variable
  return Calculate.NaN
end function

function calcSetVar(variable as string, value as string) as double
  select case variable
    case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
         "exp", "log", "ln", "int", "cint", "fix", "frac"
      Calculate.CalcError = Calculate.ErrorOverwriteFunction
      Calculate.CalcErrorTerm = variable
      return Calculate.NaN
  end select
  dim as double ret = calcPart(value)
  if Calculate.CalcError then return Calculate.NaN
  if ubound(Calculate.localVar) < 0 then
    redim Calculate.localVar(0)
    Calculate.localVar(0) = Calculate.variables(variable, ret)
  else
    for i as integer = 0 to ubound(Calculate.localVar)
      if Calculate.localVar(i).id = variable then Calculate.localVar(i).value = ret : return ret
    next
    redim preserve Calculate.localVar(ubound(Calculate.localVar)+1)
    Calculate.localVar(ubound(Calculate.localVar)) = Calculate.variables(variable, ret)
  end if
  return ret
end function

sub calcSetVar(variable as string, value as double)
  select case variable
    case "sin", "cos", "tan", "asin", "acos", "atan", "atn", "abs", "sgn", "sqr", _
         "exp", "log", "ln", "int", "cint", "fix", "frac"
      Calculate.CalcError = Calculate.ErrorOverwriteFunction
      Calculate.CalcErrorTerm = variable
      exit sub
  end select
  if ubound(Calculate.globalVar) < 0 then
    redim Calculate.globalVar(0)
    Calculate.globalVar(0) = Calculate.variables(variable, value)
  else
    for i as integer = 0 to ubound(Calculate.globalVar)
      if Calculate.globalVar(i).id = variable then Calculate.globalVar(i).value = value : exit sub
    next
    redim preserve Calculate.globalVar(ubound(Calculate.globalVar)+1)
    Calculate.globalVar(ubound(Calculate.globalVar)) = Calculate.variables(variable, value)
  end if
end sub



Beispiele:

print calc("1+2*(3-4)+sgn(-5)")


gibt -2 aus.

print calc("a=1;a+2*(3-a)+sgn(a)")

legt kurzzeitig die Variable a mit Wert 1 an und gibt 6 aus.
Prinzipiell können mehrere Rechnungen, durch Strichpunkte getrennt, hintereinander ausgeführt werden, allerdings wird immer nur der Wert der letzten Rechnung zurückgegeben.

calcSetVar("a", 1)
print calc("a+2*(3-a)+sgn(a)")

dasselbe, nur dass a nun auch für weitere Rechnungen zur Verfügung steht.

Ein Variablenname kann aus Buchstaben a-z bestehen und darf nicht mit einer der Funktionen (wie sin, abs ...) identisch sein. Groß-/Kleinschreibung wird nicht beachtet. Eine "globale" Variable kann auch "lokal" überschrieben werden.
Achtung: Die Gültigkeit einer mit calcSetVar gesetzten Variablen wird nicht überprüft; ungültige Variablenbezeichungen können jedoch nicht wieder abgerufen werden!

print calc("1+sqr(-1)^2")   ' Fehler: negativer Radikant

gibt 0 zurück (wegen des Fehlers) und setzt Calculate.CalcError auf den Wert Calculate.ErrorIllegalValue sowie Calculate.CalcErrorTerm auf den Wert "sqr(-1)".

print calc("a=.5; (a-1)(a+1)")   ' Fehler: fehlendes Malzeichen

gibt 0 und den Fehler Calculate.ErrorWrongDecimalPoint zurück. Calculate.CalcErrorTerm enthält den Wert "-0.51.5".

Hintergrund: Die beiden Klammern wurden berechnet und die Ergebnisse direkt hintereinander geschrieben. Für eine korrekte Berechnung hätte ein Malzeichen zwischen die Klammern geschrieben werden müssen. "(a+1)(a-1)" wäre übrigens in "1.5-0.5" übersetzt und dann ohne Fehlermeldung als 1 berechnet worden ...


Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 20.10.2013 von Redakteurnemored angelegt.
  • Die aktuellste Version wurde am 26.10.2013 von Redakteurnemored gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen