Evaluate and process math expressions
Posted: Wed Apr 22, 2015 10:30 pm
Hi,
this is just one more recursive descent parser.
In contrast to the code in the following post, this one evaluates mathematical expressions.
For more details see comments in the code.
//edit 2015-04-23:
Yesterday I had forgotten to translate some error messages into English. Now fixed.
//edit 2015-04-26:
-------------------------------------------------
My best tricks & tips from 15+ years
Create arrays elegantly
Extended date library
Save JSON data with object members well-arranged
Evaluate and process math expressions
Functions for sets
Statistics with R
Thue-Morse sequence
Natural sorting
Sort array indexes and parallel arrays
Time profiling
VectorIcons
Generate focus events
this is just one more recursive descent parser.
In contrast to the code in the following post, this one evaluates mathematical expressions.
For more details see comments in the code.
//edit 2015-04-23:
Yesterday I had forgotten to translate some error messages into English. Now fixed.
//edit 2015-04-26:
- added functions Ceil(), Trunc(), and Floor()
- some cosmetic changes
Code: Select all
; -- Recursive descent parser for evaluating mathematical expressions.
; works in ASCII mode and in Unicode mode
; <http://www.purebasic.fr/english/viewtopic.php?f=12&t=62125>
; o First version: 2008-07-30
; o Current version: 2015-04-26 (tested with PB 5.31)
; by Little John
; -- Notes
; o The syntax is checked rather strictly.
; o All built-in PB constants as well as self-defined constants
; can be evaluated (examples are given).
; For doing so, add the appropriate code to the procedure Const().
; o All built-in PB functions as well as self-written functions
; can be evaluated (examples are given).
; For doing so, add the appropriate code to the procedure Func().
; o The power operator "^" is handled correctly (right associative).
; o 0^0 yields 1 here, as with PB and many other programming languages.
; In mathematics, it has been discussed for a long time about the
; value of 0^0, see e.g.:
; <http://mathworld.wolfram.com/Zero.html>
; <http://mathforum.org/dr.math/faq/faq.0.to.0.power.html>
; <http://en.wikipedia.org/wiki/Exponentiation#Zero_to_the_power_of_zero>
DeclareModule Eval
;-- Error messages
#Err_BadSyntax = "Syntax error"
#Err_MissingOperator = "Missing operator"
#Err_NoClosingBracket = "Missing )"
#Err_NoOpeningBracket = "Missing ("
#Err_UnknownOperator = "Unknown operator: "
#Err_InvalidDecNumber = "Invalid decimal number"
#Err_InvalidHexNumber = "Invalid hex number"
#Err_ParameterMismatch = "(): Parameter count mismatch"
#Err_UnknownFunction = "Unknown function: "
#Err_UnknownConstant = "Unknown constant: "
#Err_NegativeBase = "Negative base with non-integer exponent"
#Err_DivisionByZero = "Division by zero"
#Err_Sqr = "Square root of negative number"
#Err_Log = "Logarithm of number <= 0"
#Err_LogBase = "Logarithm to base <= 0 or 1"
;-- Main function
Declare.s Calc(expr.s)
EndDeclareModule
Module Eval
EnableExplicit
;-- Token types
Enumeration
#Unknown
#Operator
#DecNumber
#HexNumber
#Identifier
EndEnumeration
;-- Token definitions
#OpRel = "<=<>="
#OpChars = #OpRel + "+-*/^),"
#Letters = "abcdefghijklmnopqrstuvwxyz_"
#DecDigits = "0123456789"
#HexDigits = #DecDigits + "abcdef"
#AlphaNum = #Letters + #DecDigits
;-- Constants
#E = 2.7182818284590452
Structure Tokens
Str.s
Typ.i
EndStructure
Global Dim TokenArray.Tokens(0)
Global Token.s, Error.s
Global TokenType.i
;-----------------------------------------------------------------------
Procedure NextToken (expr.s="")
; in : expr : expression to be evaluated
; out: Token : current token
; TokenType: type of current token
Static formula.s, fLen.i, posn.i
Protected left.i
If expr <> "" ; only on first call
formula = expr
fLen = Len(formula)
posn = 1
EndIf
While posn <= fLen And Mid(formula, posn, 1) = " "
posn + 1
Wend
Token = Mid(formula, posn, 1)
posn + 1
left = posn
If FindString(#OpChars, Token)
If posn <= fLen And FindString(#OpRel, Token) <> 0 And
FindString(#OpRel, Mid(formula, posn, 1)) <> 0
Token + Mid(formula, posn, 1)
posn + 1
EndIf
TokenType = #Operator
ElseIf FindString(#Letters, Token)
While posn <= fLen And FindString(#AlphaNum, Mid(formula, posn, 1)) <> 0
posn + 1
Wend
Token + Mid(formula, left, posn-left)
TokenType = #Identifier
ElseIf FindString(#DecDigits, Token)
While posn <= fLen And FindString(#DecDigits, Mid(formula, posn, 1)) <> 0
posn + 1
Wend
Token + Mid(formula, left, posn-left)
TokenType = #DecNumber
ElseIf Token = "$"
While posn <= fLen And FindString(#HexDigits, Mid(formula, posn, 1)) <> 0
posn + 1
Wend
Token + Mid(formula, left, posn-left)
TokenType = #HexNumber
Else
TokenType = #Unknown
EndIf
EndProcedure
Procedure Scan (expr.s)
;-- Split the whole expression in advance into separate tokens,
; and store them in TokenArray().
Protected index
Dim TokenArray.Tokens(Len(expr)*2) ; so the array is always big enough
index = 0
NextToken(expr)
While Token <> ""
TokenArray(index)\Str = Token
TokenArray(index)\Typ = TokenType
index + 1
NextToken()
Wend
EndProcedure
Procedure GetToken (idx=-1)
;-- get the next token from TokenArray()
Static index
If idx <> -1 ; only on first call
index = idx
EndIf
Token = TokenArray(index)\Str
TokenType = TokenArray(index)\Typ
index + 1
EndProcedure
;-----------------------------------------------------------------------
Procedure.d Arith (op.s, v.d, r.d)
Protected ret.d = #False
If Error <> ""
ProcedureReturn ret
EndIf
Select op
Case "<"
If v < r
ret = #True
EndIf
Case ">"
If v > r
ret = #True
EndIf
Case "="
If v = r
ret = #True
EndIf
Case "<>"
If v <> r
ret = #True
EndIf
Case "<="
If v <= r
ret = #True
EndIf
Case ">="
If v >= r
ret = #True
EndIf
Case "+"
ret = v + r
Case "-"
ret = v - r
Case "*"
ret = v * r
Case "/"
If r = 0
Error = #Err_DivisionByZero
Else
ret = v / r
EndIf
Case "^"
If v < 0 And r <> Int(r)
Error = #Err_NegativeBase
ElseIf v = 0 And r < 0
Error = #Err_DivisionByZero
Else
ret = Pow(v, r)
EndIf
Default
Error = #Err_UnknownOperator + op
EndSelect
ProcedureReturn ret
EndProcedure
;-- self-written functions (with as many arguments as appropriate)
Macro Ceil (_x_)
; -- round towards positive infinity
; gives the smallest integer greater than or equal to x
Round(_x_, #PB_Round_Up)
EndMacro
Macro Trunc (_x_)
; -- round towards zero
; discards the noninteger part of x
IntQ(_x_)
EndMacro
Macro Floor (_x_)
; -- round towards negative infinity
; gives the greatest integer less than or equal to x
Round(_x_, #PB_Round_Down)
EndMacro
Procedure.d Min (List args.d())
; in : List of real numbers
; out: Smallest number in the list
Protected ret.d
ret = args()
While NextElement(args())
If ret > args()
ret = args()
EndIf
Wend
ProcedureReturn ret
EndProcedure
Procedure.d Max (List args.d())
; in : List of real numbers
; out: Biggest number in the list
Protected ret.d
ret = args()
While NextElement(args())
If ret < args()
ret = args()
EndIf
Wend
ProcedureReturn ret
EndProcedure
Procedure.d Sum (List args.d())
; in : List of real numbers
; out: Sum of all numbers in the list
Protected ret.d
ret = args()
While NextElement(args())
ret + args()
Wend
ProcedureReturn ret
EndProcedure
;-----------------------------------------------------------------------
Procedure.d Const (name.s)
Protected ret.d
Select name
Case "pi"
ret = #PI
Case "e"
ret = #E
Default
Error = #Err_UnknownConstant + name
EndSelect
ProcedureReturn ret
EndProcedure
Procedure.d Func (name.s, List args.d())
; Add here the appropriate code for all functions that shall be evaluated
; (built-in PB functions or self-written functions).
; It is not necessary to check for an empty list of arguments here,
; since that will raise a syntax error anyway.
Protected ret.d
FirstElement(args())
Select name
Case "sqr"
If ListSize(args()) > 1
Error = name + #Err_ParameterMismatch
ElseIf args() < 0
Error = #Err_Sqr
Else
ret = Sqr(args())
EndIf
Case "log"
If ListSize(args()) > 2
Error = name + #Err_ParameterMismatch
ElseIf args() <= 0
Error = #Err_Log
Else
ret = Log(args()) ; Default base is 'e'.
If ListSize(args()) = 2 ; If a different base is given ...
NextElement(args())
If args() <= 0 Or args() = 1
Error = #Err_LogBase
Else
ret / Log(args())
EndIf
EndIf
EndIf
Case "ceil"
If ListSize(args()) > 1
Error = name + #Err_ParameterMismatch
Else
ret = Ceil(args())
EndIf
Case "trunc"
If ListSize(args()) > 1
Error = name + #Err_ParameterMismatch
Else
ret = Trunc(args())
EndIf
Case "floor"
If ListSize(args()) > 1
Error = name + #Err_ParameterMismatch
Else
ret = Floor(args())
EndIf
Case "min"
ret = Min(args())
Case "max"
ret = Max(args())
Case "sum"
ret = Sum(args())
Default
Error = #Err_UnknownFunction + name
EndSelect
ProcedureReturn ret
EndProcedure
;-----------------------------------------------------------------------
;-- recursive procedures
Declare.d Expression()
Procedure.d Factor()
Protected op.s
Protected v.d
If TokenType = #DecNumber
op = Token
GetToken()
If Token <> "."
v = Val(op)
Else
GetToken()
If TokenType = #DecNumber
v = ValD(op + "." + Token)
Else
Error = #Err_InvalidDecNumber
EndIf
GetToken()
EndIf
ElseIf TokenType = #HexNumber
If Len(Token) > 1
v = Val(Token)
Else
Error = #Err_InvalidHexNumber
EndIf
GetToken()
ElseIf TokenType = #Identifier
op = Token
GetToken()
If Token = "("
;-- get list of function arguments
Protected NewList args.d()
Repeat
GetToken()
AddElement(args())
args() = Expression()
Until Token <> ","
If Token <> ")" And Error = ""
Error = #Err_NoClosingBracket
EndIf
v = Func(op, args())
GetToken()
Else
v = Const(op)
EndIf
ElseIf Token = "("
GetToken()
v = Expression()
If Token <> ")" And Error = ""
Error = #Err_NoClosingBracket
EndIf
GetToken()
Else
Error = #Err_BadSyntax
EndIf
If Token <> "" And FindString(#OpChars, Token) = 0 And Error = ""
If TokenType = #DecNumber Or TokenType = #HexNumber Or
TokenType = #Identifier Or Token = "("
Error = #Err_MissingOperator
Else
Error = #Err_UnknownOperator + Token
EndIf
EndIf
ProcedureReturn v
EndProcedure
Procedure.d Power()
Protected v.d, r.d
v = Factor()
If Token = "^"
GetToken()
r = Power()
v = Arith("^", v, r)
EndIf
ProcedureReturn v
EndProcedure
Procedure.d Term()
Protected op.s
Protected v.d, r.d
v = Power()
op = Token
While op = "*" Or op = "/"
GetToken()
r = Power()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
Procedure.d Signed()
Protected op.s
Protected v.d
op = ""
If Token = "+" Or Token = "-"
op = Token
GetToken()
EndIf
v = Term()
If op = "-"
v = -v
EndIf
ProcedureReturn v
EndProcedure
Procedure.d SingleExpression()
Protected op.s
Protected v.d, r.d
v = Signed()
op = Token
While op = "+" Or op = "-"
GetToken()
r = Term()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
Procedure.d Expression()
Protected op.s
Protected v.d, r.d
v = SingleExpression()
op = Token
While FindString(#OpRel, op) <> 0
GetToken()
r = SingleExpression()
v = Arith(op, v, r)
op = Token
Wend
ProcedureReturn v
EndProcedure
;-----------------------------------------------------------------------
Procedure.s Calc (expr.s)
; * Main function *
; in : expression to be evaluated
; out: result (1st character is '-' or a decimal digit)
; or
; error message (1st character is a letter)
Protected v.d
Scan(LCase(expr))
Error = ""
GetToken(0)
v = Expression()
If Error <> ""
ProcedureReturn Error
ElseIf Token = ")"
ProcedureReturn #Err_NoOpeningBracket
ElseIf Token = ","
ProcedureReturn #Err_BadSyntax
Else ; no error
ProcedureReturn StrD(v) ; return result
EndIf
EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
; -- Module demo
Debug Eval::Calc("-1 < 7")
Debug Eval::Calc(" 1 > -7")
Debug Eval::Calc(" 4 = 5")
Debug Eval::Calc(" 4 <> 5")
Debug Eval::Calc(" 4 <= 5")
Debug Eval::Calc(" 4 >= 5")
Debug Eval::Calc("(4+2) = 6")
Debug Eval::Calc(" 4+2 = 6")
Debug Eval::Calc("6 = (4+2)")
Debug Eval::Calc("6 = 4+2")
Debug ""
Debug Eval::Calc(" 2+3+4")
Debug Eval::Calc(" 2-3*4")
Debug Eval::Calc(" +2+3*4")
Debug Eval::Calc(" -2+3*4")
Debug Eval::Calc(" 12*2")
Debug Eval::Calc(" -3*4")
Debug Eval::Calc("(2+3)*4")
Debug ""
Debug Eval::Calc("4^3^2")
Debug Eval::Calc("4^(3^2)")
Debug Eval::Calc("(4^3)^2")
Debug ""
Debug Eval::Calc("Ceil ( 3.2)")
Debug Eval::Calc("Ceil (-3.8)")
Debug Eval::Calc("Trunc( 4.7)")
Debug Eval::Calc("Trunc(-4.7)")
Debug Eval::Calc("Floor( 3.8)")
Debug Eval::Calc("Floor(-3.2)")
CompilerEndIf-------------------------------------------------
My best tricks & tips from 15+ years
Create arrays elegantly
Extended date library
Save JSON data with object members well-arranged
Evaluate and process math expressions
Functions for sets
Statistics with R
Thue-Morse sequence
Natural sorting
Sort array indexes and parallel arrays
Time profiling
VectorIcons
Generate focus events
