Thursday, 11 July 2013

Mathematical Expression Dialect Parser

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
]

2 comments:

  1. Lovely article. I've not heard of Rebol before.

    For your information, I have also implemented C++/Java expression parsers to convert expressions into reverse Polish notation and evaulate the result, though yours seems a lot more straightforward!

    Some free downloads can be found at this link.:

    http://www.technical-recipes.com/2011/a-mathematical-expression-parser-in-java-and-cpp/

    Comments and suggestions welcome/

    ReplyDelete