Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Parser für algebraische Ausdrücke (expression parser)
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| MIT-Lizenz |  nemored |  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:
- Fehlerbehebung bei den Funktionen sqr und atn (falscher Definitionsbereich)
- Bei einem Rechenfehler wird nun nan (not a number) statt 0 zurückgegeben.
' 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 Malzeichengibt 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 | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen