The following script permits you to evaluate correctly math expressions.
For example rebol way to evaluate is wrong in this case (the correct result is 50):
>> 5 + 5 * 3 ** 2
== 900.0
Rebol evaluates without sign precedence.
Fortunately using
parse-expression function, any expression is correctly evaluated:
>> parse-expression "5+5*3**2"
== [add 5.0 multiply 5.0 power 3.0 2.0]
>> do parse-expression "5+5*3**2"
== 50.0
You can use the following therms:
- **
- abs()
- arcos() or acos()
- arcsin() or asin()
- arctan() or atan()
- cos()
- exp()
- log() or log10()
- log2()
- ln()
- sin()
- sqrt()
- tan()
Here is the source:
REBOL [
File: %parse-expression.r
Date: 21-Mar-2011
Title: "Mathematical Expression Dialect Parser"
Author: "Francois Vanzeveren"
Purpose: {Converts a mathematical expression into a block of rebol code that can be evaluated.}
Version: 0.9.6
History: [
0.9.6 21-Mar-2011 "Francois Vanzeveren"
{- The caret character (^^) can now be used for exponentiation
- Minor improvement to ease the use of the library}
0.9.5 16-Mar-2011 "Francois Vanzeveren"
{- BUG FIX: The evaluation of an expression containing trigonometric functions
caused an error.
- BUG FIX: The exponentiation of built-in functions (e.g. "log(2)**2")caused an error.
- New built-in functions: log2()}
0.9.4 15-Mar-2011 "Francois Vanzeveren"
{- BUG FIX: + - * / and // are now left-associative! Thanks to Ladislav from REBOL3
on altme for reporting this bug!}
0.9.3 14-Mar-2011 "Francois Vanzeveren"
{- BUG FIX: signed numbers and signed (sub-)expressions are now properly handled.
e.g. "+(1+x)/-(1-x)" returns [divide add 1.0 x negate subtract 1.0 x]}
0.9.2 14-Mar-2011 "Francois Vanzeveren"
{-IMPROVEMENT: much more readable and elegant recursive implementation.
- BUG FIX: precedence between '**' and '*' fixed, e.g 2**3*6 will now return
[multiply power 2 3 6] instead of [power 2 multiply 3 6]}
0.9.1 13-Mar-2011 "Francois Vanzeveren"
{New functions implemented:
abs(), arcos(), acos(), arcsin(), asin(), arctan(), atan(), cos(), exp(),
log(), ln(), sin(), sqrt(), tan()}
0.9.0 13-Mar-2011 "Francois Vanzeveren"
"First public release. Future versions will provide additional functions."
]
TO-DO: {
Version 1.0.0
- expression syntax error handling to return usefull messages to the user when
she/he makes syntax errors in the expression.
}
license: 'lgpl
]
parse-expression: func [
p_expression [string!] "The expression to parse."
/local eq retval parent-depth str tmp char
] [
eq: trim/all lowercase copy p_expression
if empty? eq [return copy []]
retval: copy []
; Avons-nous à faire à un nombre?
if tmp: attempt [to-decimal eq] [
append retval tmp
return retval
]
parent-depth: 0
str: copy ""
char: copy ""
; We first search for operators of first precedence (+ and -)
parse/all eq [
any [
"+" (
either any [greater? parent-depth 0 empty? char found? find "+-*/(" char]
[append str "+"]
[
insert retval 'add ; by using 'insert...
append retval parse-expression str ; and 'append, we preserve the left-associativity of the addition
str: copy ""
]
char: copy "+"
) |
"-" (
either any [greater? parent-depth 0 empty? char found? find "+-*/(" char]
[append str "-"]
[
insert retval 'subtract ; by using 'insert
append retval parse-expression str ; and 'append, we preserve the left-associativity of the subtraction
str: copy ""
]
char: copy "-"
) |
"(" (
append str "("
parent-depth: add parent-depth 1
char: copy "("
) |
")" (
append str ")"
parent-depth: subtract parent-depth 1
char: copy ")"
) |
copy char skip (append str char)
]
]
if not empty? retval [
append retval parse-expression str
return retval
]
; We did not find operator of first precedence (+ and -)
; We look now for second precedence (* and /).
parent-depth: 0
str: copy ""
parse/all eq [
any [
"**" (append str "**" char: copy "*") |
"*" (
either zero? parent-depth [
insert retval 'multiply ; by using 'insert...
append retval parse-expression str ; and 'append, we preserve the left-associativity of the multiplication
str: copy ""
] [append str "*"]
char: copy "*"
) |
"//" (
either zero? parent-depth [
insert retval 'remainder ; by using 'insert...
append retval parse-expression str ; and 'append, we preserve the left-associativity of the remainder
str: copy ""
] [append str "//"]
char: copy "/"
) |
"/" (
either zero? parent-depth [
insert retval 'divide ; by using 'insert...
append retval parse-expression str ; and 'append, we preserve the left-associativity of the division
str: copy ""
] [append str "/"]
char: copy "/"
) |
"(" (
append str "("
parent-depth: add parent-depth 1
char: copy "("
) |
")" (
append str ")"
parent-depth: subtract parent-depth 1
char: copy ")"
) |
copy char skip (append str char)
]
]
if not empty? retval [
append retval parse-expression str
return retval
]
; Toujours rien? Il s'agit alors:
; * soit d'un exposant
; * soit d'un opérateur unitaire
; * soit d'une expression entièrement comprise entre parenthèse
; * soit d'une inconnue
; Exposant
parent-depth: 0
str: copy ""
parse/all eq [
any [
"**" (
either zero? parent-depth [
append retval 'power
append retval parse-expression str
str: copy ""
] [append str "**"]
) |
"^^" (
either zero? parent-depth [
append retval 'power
append retval parse-expression str
str: copy ""
] [append str "^^"]
) |
"(" (
append str "("
parent-depth: add parent-depth 1
) |
")" (
append str ")"
parent-depth: subtract parent-depth 1
) | copy char skip (append str char)
]
]
if not empty? retval [
append retval parse-expression str
return retval
]
; opérateur unitaire
parent-depth: 0
str: copy ""
parse/all eq [
"+" copy str to end (
append retval parse-expression str
return retval
) |
"-" copy str to end (
append retval 'negate
append retval parse-expression str
return retval
) |
"abs(" copy str to end (
remove back tail str
append retval 'abs
append retval parse-expression str
return retval
) |
"arccos(" copy str to end (
remove back tail str
append/only retval 'arccosine/radians
append retval parse-expression str
return retval
) |
"acos(" copy str to end (
remove back tail str
append/only retval 'arccosine/radians
append retval parse-expression str
return retval
) |
"arcsin(" copy str to end (
remove back tail str
append/only retval 'arcsine/radians
append retval parse-expression str
return retval
) |
"asin(" copy str to end (
remove back tail str
append/only retval 'arcsine/radians
append retval parse-expression str
return retval
) |
"arctan(" copy str to end (
remove back tail str
append/only retval 'arctangent/radians
append retval parse-expression str
return retval
) |
"atan(" copy str to end (
remove back tail str
append/only retval 'arctangent/radians
append retval parse-expression str
return retval
) |
"cos(" copy str to end (
remove back tail str
append/only retval 'cosine/radians
append retval parse-expression str
return retval
) |
"exp(" copy str to end (
remove back tail str
append retval 'exp
append retval parse-expression str
return retval
) |
"log2(" copy str to end (
remove back tail str
append retval 'log-2
append retval parse-expression str
return retval
) |
"log10(" copy str to end (
remove back tail str
append retval 'log-10
append retval parse-expression str
return retval
) |
"log(" copy str to end (
remove back tail str
append retval 'log-10
append retval parse-expression str
return retval
) |
"ln(" copy str to end (
remove back tail str
append retval 'log-e
append retval parse-expression str
return retval
) |
"sin(" copy str to end (
remove back tail str
append/only retval 'sine/radians
append retval parse-expression str
return retval
) |
"sqrt(" copy str to end (
remove back tail str
append retval 'square-root
append retval parse-expression str
return retval
) |
"tan(" copy str to end (
remove back tail str
append/only retval 'tangent/radians
append retval parse-expression str
return retval
)
]
; Expression complètement comprise entre parenthèses.
if equal? #"(" first eq [
remove head eq ; on supprimer la parenthèse ouvrante
remove back tail eq ; on supprimer la parenthèse fermante
append retval parse-expression eq
return retval
]
; il ne reste plus que l'hypothèse d'une inconnue
append retval to-word eq
return retval
]
