View documentation | View script | License |
Download script | History | Other scripts by: fvzv |
8-Sep 0:00 UTC
[0.042] 16.602k
[0.042] 16.602k
Archive version of: parse-equation.r ... version: 3 ... fvzv 14-Mar-2011REBOL [ File: %parse-equation.r Date: 14-Mar-2011 Title: "Equation Dialect Parser" Author: "Francois Vanzeveren" Purpose: {Converts a mathematical equation into a block of rebol code that can be evaluated.} Version: 0.9.2 History: [ 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 - Equation syntax error handling to return usefull messages to the user when she/he makes syntax errors in the equation. } Library: [ level: 'intermediate platform: 'all type: [dialect function] domain: 'math tested-under: [windows linux] license: 'lgpl ] ] parse-equation: func [ p_equation [string!] "The equation to parse." /local eq retval parent-depth str tmp char ] [ eq: trim/all lowercase copy p_equation retval: copy [] parent-depth: 0 str: copy "" ; Avons-nous à faire à un nombre? if tmp: attempt [to-decimal eq] [ append retval tmp return retval ] ; We first search for operators of first precedence (+ and -) parse/all eq [ any [ "+" ( either zero? parent-depth [ append retval 'add append retval parse-equation str str: copy "" ] [append str "+"] ) | "-" ( either zero? parent-depth [ append retval 'subtract append retval parse-equation 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-equation 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 "**") | "*" ( either zero? parent-depth [ append retval 'multiply append retval parse-equation str str: copy "" ] [append str "*"] ) | "//" ( either zero? parent-depth [ append retval 'remainder append retval parse-equation str str: copy "" ] [append str "//"] ) | "/" ( either zero? parent-depth [ append retval 'divide append retval parse-equation 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-equation str return retval ] ; Toujours rien? Il s'agit alors: ; * soit d'un opérateur unitaire ; * soit d'une expression entièrement comprise entre parenthèse ; * soit d'une inconnue parent-depth: 0 str: copy "" ; opérateur unitaire parse/all eq [ "abs(" copy str to end ( remove back tail str append retval 'abs append retval parse-equation str return retval ) | "arccos(" copy str to end ( remove back tail str append retval to-word "arccosine/radians" append retval parse-equation str return retval ) | "acos(" copy str to end ( remove back tail str append retval to-word "arccosine/radians" append retval parse-equation str return retval ) | "arcsin(" copy str to end ( remove back tail str append retval to-word "arcsine/radians" append retval parse-equation str return retval ) | "asin(" copy str to end ( remove back tail str append retval to-word "arcsine/radians" append retval parse-equation str return retval ) | "arctan(" copy str to end ( remove back tail str append retval to-word "arctangent/radians" append retval parse-equation str return retval ) | "atan(" copy str to end ( remove back tail str append retval to-word "arctangent/radians" append retval parse-equation str return retval ) | "cos(" copy str to end ( remove back tail str append retval to-word "cosine/radians" append retval parse-equation str return retval ) | "exp(" copy str to end ( remove back tail str append retval 'exp append retval parse-equation str return retval ) | "log(" copy str to end ( remove back tail str append retval 'log-10 append retval parse-equation str return retval ) | "ln(" copy str to end ( remove back tail str append retval 'log-e append retval parse-equation str return retval ) | "sin(" copy str to end ( remove back tail str append retval to-word "sine/radians" append retval parse-equation str return retval ) | "sqrt(" copy str to end ( remove back tail str append retval 'square-root append retval parse-equation str return retval ) | "tan(" copy str to end ( remove back tail str append retval 'tangent append retval parse-equation str return retval ) ] parent-depth: 0 str: copy "" parse/all eq [ any [ "**" ( either zero? parent-depth [ append retval 'power append retval parse-equation 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-equation str return retval ] 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-equation eq return retval ] ; il ne reste plus que l'hypothèse d'une inconnue append retval to-word eq return retval ] Notes
|