eumandy/eugtk/examples/glade/math_eval.e
2016-11-25 00:33:18 -07:00

1259 lines
44 KiB
Plaintext

-- PROJECT: MATH_EVAL
-- VERSION: 1.1.0 3.12.2014 (created on LinuxMint 17, using Geany editor).
-- AUTHOR: Shian Lee
-- LANGUAGE: Euphoria 4.1.0 <http://openeuphoria.org/>
-- LICENSE: Free. Use at your own risk.
-- --------------------------------------------------------------------------
-- PURPOSE: a function which evaluate Euphoria's math expressions,
-- and returns atom as result, or an error message string.
-- typically used to calculate math expressions entered by the user.
-- math_eval supports functions, operators, variables & constants.
-- read the attached "math_eval.doc" user manual for details.
-- NOTE: * the code checks for errors so your program will not crash.
-- * expressions are evaluated in the same manner as Euphoria 4.1.
-- * sequences are not supported (it's used mainly in spreadsheets).
-- ==========================================================================
-- current version of math_eval, used by demo programs help:
public constant
MATH_EVAL_VERSION = "Expression Calculator 1.1.0, 3.12.2014, Shian Lee."
-- include Euphoria 4.1.0 library files:
include std/types.e -- useful types and constants, e.g. boolean().
include std/math.e -- math functions and math constants, e.g. abs().
include std/get.e -- value().
include std/convert.e -- to_number(), set_decimal_mark().
include std/text.e -- trim().
include std/sequence.e -- remove_all().
-- EUPHORIA OPERATORS & CONSTANT & FUNCTIONS CONSTANTS ======================
-- NOTE: functions, constants, operators - are all INDEXED. if you can't
-- implement one of them then you MUST NOT REMOVE IT; it's there
-- to be implemented later. instead you should replace the calculation
-- of functions with: return err_msg(ER_NOT_IMPLEMENTED, "func-name").
-- - this note is especially important for converting the syntax to
-- Euphoria 3.1.1.
-- - new functions/constants/operators may be appended TO THE END of a
-- list though - this will not break the existing code.
constant
-- parse_expr() keeps the index of functions, instead of the identifier
-- name itself, i.e. {FUNC_ID, func_ix}, e.g. "power" --> {'@', 25};
-- FUNC_ID must be integer, not part of the syntax, e.g. '@', 999, etc:
FUNC_ID = '@',
-- Euphoria 4 precedence lists (Euphoria 4.1 manual - 4.1.5 Precedence Chart):
-- all items in precedence list must be of "string" type:
PRECEDENCE_LISTS = { -- [index] description:
{}, -- (place holder) -- [1] parenthesis () (highest)
{}, -- (place holder) -- [2] function calls
{}, -- (place holder) -- [3] unary- unary+ not
{"*", "/"}, -- [4] * /
{"+", "-"}, -- [5] + -
{"<", ">", "<=", ">=", "=", "!="}, -- [6] < > <= >= = !=
{"and", "or", "xor"} -- [7] and or xor
},
-- all items in unary operators list must be of "string" type:
UNARY_OP_LIST = {"-", "+", "not"},
-- Euphoria 4 operators list (Euphoria 4.1 manual - 4.1.4 Expressions);
-- all items in op list must be of "string" type:
OP_LIST = { -- [index] description:
"*", -- [1] * PRECEDENCE_LISTS[4]
"/", -- [2] /
"+", -- [3] + PRECEDENCE_LISTS[5]
"-", -- [4] -
"<", -- [5] < PRECEDENCE_LISTS[6]
">", -- [6] >
"<=", -- [7] <=
">=", -- [8] >=
"=", -- [9] =
"!=", -- [10] !=
"and", -- [11] and PRECEDENCE_LISTS[7]
"or", -- [12] or
"xor", -- [13] xor
"not" -- [14] not PRECEDENCE_LISTS[3]
},
-- Euphoria 4 constants list (Euphoria 4.1 manual - 8.26.1 Math Constants);
-- these are two paralleled lists: constants names & constants values:
-- all items in const list must be of "string" type:
CONST_LIST = { -- [index]
"PI", -- [1]
"QUARTPI", -- [2]
"HALFPI", -- [3]
"TWOPI", -- [4]
"PISQR", -- [5]
"INVSQ2PI", -- [6]
"PHI", -- [7]
"E", -- [8]
"LN2", -- [9]
"INVLN2", -- [10]
"LN10", -- [11]
"INVLN10", -- [12]
"SQRT2", -- [13]
"HALFSQRT2", -- [14]
"SQRT3", -- [15]
"DEGREES_TO_RADIANS", -- [16]
"RADIANS_TO_DEGREES", -- [17]
"EULER_GAMMA", -- [18]
"SQRTE", -- [19]
"PINF", -- [20]
"MINF", -- [21]
"SQRT5" -- [22]
},
-- all items in const list values must be of atom type:
CONST_LIST_VALUES = { -- [index]
PI, -- [1]
QUARTPI, -- [2]
HALFPI, -- [3]
TWOPI, -- [4]
PISQR, -- [5]
INVSQ2PI, -- [6]
PHI, -- [7]
E, -- [8]
LN2, -- [9]
INVLN2, -- [10]
LN10, -- [11]
INVLN10, -- [12]
SQRT2, -- [13]
HALFSQRT2, -- [14]
SQRT3, -- [15]
DEGREES_TO_RADIANS, -- [16]
RADIANS_TO_DEGREES, -- [17]
EULER_GAMMA, -- [18]
SQRTE, -- [19]
PINF, -- [20]
MINF, -- [21]
SQRT5 -- [22]
},
-- Euphoria 4 functions list (+ your own documented functions...);
-- all items in functions list must be of "string" type:
FUNC_LIST = { -- [index] description:
"abs", -- [1] Eu 4.1 manual - 8.25.1 Sign and Comparisons:
"sign", -- [2]
"larger_of", -- [3]
"smaller_of", -- [4]
"remainder", -- [5] Eu 4.1 manual - 8.25.2 Roundings and Remainders:
"mod", -- [6]
"trunc", -- [7]
"frac", -- [8]
"intdiv", -- [9]
"floor", -- [10]
"ceil", -- [11]
"round", -- [12]
"arctan", -- [13] Eu 4.1 manual - 8.25.3 Trigonometry:
"tan", -- [14]
"cos", -- [15]
"sin", -- [16]
"arccos", -- [17]
"arcsin", -- [18]
"atan2", -- [19]
"rad2deg", -- [20]
"deg2rad", -- [21]
"log", -- [22] Eu 4.1 manual - 8.25.4 Logarithms and Powers:
"log10", -- [23]
"exp", -- [24]
"power", -- [25]
"sqrt", -- [26]
"fib", -- [27]
"cosh", -- [28] Eu 4.1 manual - 8.25.5 Hyperbolic Trigonometry:
"sinh", -- [29]
"tanh", -- [30]
"arcsinh", -- [31]
"arccosh", -- [32]
"arctanh", -- [33]
"and_bits", -- [34] Eu 4.1 manual - 8.25.7 Bitwise Operations:
"xor_bits", -- [35]
"or_bits", -- [36]
"not_bits", -- [37]
"shift_bits", -- [38]
"rotate_bits", -- [39]
"gcd", -- [40]
"approx", -- [41]
"powof2", -- [42]
"is_even", -- [43]
"rand", -- [44] Eu 4.1 manual - 8.27 Random Numbers:
"rand_range", -- [45]
"rnd", -- [46]
"rnd_1", -- [47]
"chance", -- [48]
"roll", -- [49]
"compare", -- [50] Eu 4.1 manual - 8.15.1 Equality
-- added in version 1.1.0:
"time" -- [51] Eu 4.1 manual - 8.4.5.1 time
}
-- OTHER CONSTANTS ==========================================================
constant
-- common error messages used by err_msg():
ER_NOT_IMPLEMENTED = "Sorry, function not implemented yet",
ER_SYNTAX_ERROR = "Syntax error in",
ER_DEV_BY_ZERO = "Division by zero in",
ER_UNDEFINED_RES = "Undefined result in",
ER_ILLEGAL_ARG = "Illegal argument in",
ER_BUG_IN_CODE = "Sorry... BUG in routine",
-- nul (ASCII-0) can be used as end-of-string marker where needed:
NUL = 0
-- TYPES & UTILITIES ========================================================
-- PURPOSE: test if s is a sequence of strings, e.g. {"xyz", "..."}.
-- NOTE: string is byte-characters from 0 to 255.
type seq_of_strings(sequence s)
for i = 1 to length(s) do
if not string(s[i]) then
return FALSE
end if
end for
return TRUE
end type
-- PURPOSE: test if s is a sequence of atoms and/or strings, e.g. {"4", -1.5}.
type seq_of_values(sequence s)
for i = 1 to length(s) do
if not atom(s[i]) then
if not string(s[i]) then
return FALSE
end if
end if
end for
return TRUE
end type
-- PURPOSE: test if s is a sequence of two sequences of the same length.
type paralleled_seq(sequence s)
if length(s) = 2 then
if sequence(s[1]) and sequence(s[2]) then
if length(s[1]) = length(s[2]) then
return TRUE
end if
end if
end if
return FALSE
end type
-- PURPOSE: identical to std/sequence.e - remove_dups(s, RD_INPLACE); just
-- much shorter, since not using sort(). See help for remove_dups().
function remove_dups_inplace(sequence source_data)
sequence lResult = {}
for i = 1 to length(source_data) do
if not find(source_data[i], lResult) then
lResult = append(lResult, source_data[i])
end if
end for
return lResult
end function
-- PURPOSE: construct a returned error message.
-- DETAILS: msg is the error text.
-- symbol is any element (function, operator, etc) to add. ""=none.
-- pos is position (column) of error. 0=none.
-- OUTPUT: error_occurred
-- RETURN: ascii_string; short error message.
-- EXAMPLE: st = err_msg("Arrays not supported in", "abs", 7)
-- --> st is "[Arrays not supported in 'abs' at position 7]"
-- SEEALSO: math_eval, parse_expr, set_local_variables, ER_ constants above.
constant
-- start and end of error message must be a single char:
ERR_MSG_HEAD = '[',
ERR_MSG_TAIL = ']'
boolean
error_occurred = FALSE -- reset for debug & also by set_local_variables().
function err_msg(ascii_string msg, ascii_string symbol = "", integer pos = 0)
ascii_string pos_str = ""
error_occurred = TRUE -- set error flag
if length(symbol) then
symbol = " '" & symbol & "'"
end if
if pos then
pos_str = sprintf(" at position %d", pos)
end if
return ERR_MSG_HEAD & msg & symbol & pos_str & ERR_MSG_TAIL
end function
-- PURPOSE: convert a string to number. supports binary, octal, decimal,
-- hexadecimal (0b, 0t, 0d, 0x, #) with decimal marker, and number
-- in scientific notation.
-- * eui supports decimal marker only for decimal, e.g. 1.2; 5.1e+2.
-- DETAILS: s is a *trimmed* string which represents a number.
-- RETURN: object; meaningless sequence on error; result atom on success.
-- NOTE: set_decimal_mark('.') is done by set_local_variables(), for
-- compatibility with 'eui' syntax.
-- EXAMPLE: x = string_to_number("0xFF") -- x is 255
-- SEEALSO: parse_expr, set_local_variables
function string_to_number(string s)
object r
integer len = length(s)
-- value() don't support '_'; to_number() don't support 0b_11 case, etc:
s = remove_all('_', s)
-- # 16 = Hexadecimal (with lower a-f and decimal marker support):
if len and s[1] = '#' then
r = to_number(s, -1)
-- 0b/0t/0d/0x Binary/Octal/Decimal/Hexadecimal numbers:
elsif len >= 2 and s[1] = '0' and find(s[2], "btdx") then
switch s[2] do
case 'b' then -- 0b 2 = Binary
s[2] = '!'
case 't' then -- 0t 8 = Octal
s[2] = '@'
case 'd' then -- 0d 10 = Decimal
s[2] = 32
case 'x' then -- 0x 16 = Hexadecimal
s[2] = '#'
end switch
r = to_number(tail(s), -1) -- ! Euphoria 3: tail(s) is s[2..len].
else -- Decimal or Number in scientific notation:
r = value(s, 1, GET_LONG_ANSWER)
if r[1] = GET_SUCCESS and r[3] = length(s) then
r = r[2]
end if
end if
return r
end function
-- PURPOSE: set on enter - or - reset on exit local variables.
-- DETAILS: see 'boolean reset constants' below.
-- OUTPUT: error_occurred
-- SEEALSO: math_eval, get_identifiers, string_to_number, err_msg
constant
-- boolean reset constants:
ON_ENTER = FALSE, -- set local variables
ON_EXIT = TRUE -- reset local variables
integer
prev_decimal_mark
procedure set_local_variables(boolean reset)
if reset = ON_EXIT then
-- restore previous decimal mark ('.' or ','):
if prev_decimal_mark != '.' then
if set_decimal_mark(prev_decimal_mark) then
end if
end if
else -- reset = ON_ENTER:
-- to_number() is using '.' for compatibility with 'eui' syntax:
prev_decimal_mark = set_decimal_mark('.')
-- error flag *must* be reset *ON_ENTER* (not on exit), since
-- math_eval() is calling itself recursively and checks this flag:
error_occurred = FALSE
end if
end procedure
-- PURPOSE: convert sequence of comma-delimited-arguments to sequence of atoms.
-- DETAILS: e is sequence of comma-delimited-arguments, e.g. {5, ",", 20.1}
-- RETURN: sequence; result sequence or err_msg() string.
-- EXAMPLE: s = arguments_to_sequence({10.4, ",", -3, ",", 401})
-- --> s is {10.4, -3, 401}
-- SEEALSO: calc_func
function arguments_to_sequence(sequence e)
sequence atoms = {}
integer len = length(e)
-- check for valid arguments, e.g. {}, {1.3}, {5, ",", 20, ",", 3.1}:
if len = 0 then
return atoms
elsif remainder(len, 2) and atom(e[len]) then
for i = 1 to len - 1 by 2 do
if atom(e[i]) and equal(e[i + 1], ",") then
atoms = append(atoms, e[i])
else
return err_msg(ER_ILLEGAL_ARG)
end if
end for
return append(atoms, e[len])
else
return err_msg(ER_ILLEGAL_ARG)
end if
end function
-- CHUNK CALCULATION ========================================================
-- PURPOSE: if use_degrees is FALSE then Radians are passed to trigonometry
-- functions as tan(); if is TRUE then Degrees are passed to these
-- functions (therefor must be converted to Radians before use).
-- SEEALSO: math_eval, calc_func_1
boolean
use_degrees -- output by math_eval().
-- FUNCTIONS: calc_func_0, calc_func_1, calc_func_2, calc_func_x.
-- PURPOSE: calculate a function expression with 0 to 2 or 3+ arguments.
-- DETAILS: name is name of function, e.g. "abs".
-- ix is the function index in FUNC_LIST, e.g. 1.
-- a1, a2 are the function's arguments, by standard order;
-- a is sequence of arguments in case of calc_func_x().
-- RETURN: object; result atom or err_msg() string.
-- NOTE: calc_func_# separated into few routines for easier debugging.
-- EXAMPLE: x = calc_func_0("rnd" , 46) --> x might be 0.3343612548
-- x = calc_func_1("abs" , 1 , -7) --> x is 7
-- x = calc_func_2("power" , 25, 11, 3) --> x is 1331
-- x = calc_func_x("approx", 41, {9, 8, 0.5}) --> x is 1
-- SEEALSO: calc_func, calc_op, calc_unary_op, calc_expr
function calc_func_0(sequence name, integer ix)
atom r
switch ix do
case 46 then -- [46] "rnd"
r = rnd()
case 47 then -- [47] "rnd_1"
r = rnd_1()
case 51 then -- [51] "time"
r = time()
case else
return err_msg(ER_ILLEGAL_ARG, name)
end switch
return r
end function
-- PURPOSE: see calc_func_0().
-- INPUT: use_degrees
function calc_func_1(sequence name, integer ix, atom a1)
atom r
-- first convert degrees to radians for trigonometry functions:
-- (see: Euphoria 4.1 Manual 8.25.3 Trigonometry).
if use_degrees then
switch ix do
-- [13] "arctan", [14] "tan", [15] "cos",
-- [16] "sin", [17] "arccos", [18] "arcsin",
case 13, 14, 15, 16, 17, 18 then
a1 = deg2rad(a1)
end switch
end if
switch ix do
case 1 then -- [1] "abs"
r = abs(a1)
case 2 then -- [2] "sign"
r = sign(a1)
case 7 then -- [7] "trunc"
r = trunc(a1)
case 8 then -- [8] "frac"
r = frac(a1)
case 10 then -- [10] "floor"
r = floor(a1)
case 11 then -- [11] "ceil"
r = ceil(a1)
case 13 then -- [13] "arctan"
r = arctan(a1)
case 14 then -- [14] "tan"
-- PI is infinite so we don't get Error/Zero result when a1 is 0/
-- 90/180/270/etc degrees; so convert a1 to degrees and round it:
r = remainder(round(abs(rad2deg(a1)), 1000000000), 180)
-- in case of 90, 270, 450 degrees, etc, then r is infinite:
if r = 90 then
return err_msg(ER_UNDEFINED_RES, name)
-- in case of 0, 180, 360, 540 degrees, etc, then r is 0:
elsif r != 0 then
r = tan(a1)
end if
case 15 then -- [15] "cos"
r = cos(a1)
case 16 then -- [16] "sin"
r = sin(a1)
case 17 then -- [17] "arccos"
if a1 >= -1 and a1 <= 1 then
r = arccos(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 18 then -- [18] "arcsin"
if a1 >= -1 and a1 <= 1 then
r = arcsin(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 20 then -- [20] "rad2deg"
r = rad2deg(a1)
case 21 then -- [21] "deg2rad"
r = deg2rad(a1)
case 22 then -- [22] "log"
if a1 > 0 then
r = log(a1)
else
return err_msg(ER_UNDEFINED_RES, name)
end if
case 23 then -- [23] "log10"
if a1 > 0 then
r = log10(a1)
else
return err_msg(ER_UNDEFINED_RES, name)
end if
case 24 then -- [24] "exp"
r = exp(a1)
case 26 then -- [26] "sqrt"
if a1 >= 0 then
r = sqrt(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 27 then -- [27] "fib"
if integer(a1) then
r = fib(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 28 then -- [28] "cosh"
r = cosh(a1)
case 29 then -- [29] "sinh"
r = sinh(a1)
case 30 then -- [30] "tanh"
r = tanh(a1)
case 31 then -- [31] "arcsinh"
r = arcsinh(a1)
case 32 then -- [32] "arccosh"
if a1 >= 1 then
r = arccosh(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 33 then -- [33] "arctanh"
if a1 > -1 and a1 < 1 then
r = arctanh(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 37 then -- [37] "not_bits"
r = not_bits(a1)
case 42 then -- [42] "powof2"
r = powof2(a1)
case 43 then -- [43] "is_even"
if integer(a1) then
r = is_even(a1)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
case 44 then -- [44] "rand"
r = rand(a1)
case else
return err_msg(ER_ILLEGAL_ARG, name)
end switch
return r
end function
-- PURPOSE: see calc_func_0().
function calc_func_2(sequence name, integer ix, atom a1, atom a2)
atom r
-- first check for common errors:
switch ix do
-- [5] "remainder", [6] "mod", [9] "intdiv", [12] "round"
case 5, 6, 9, 12 then
if a2 = 0 then
return err_msg(ER_DEV_BY_ZERO, name)
end if
-- [38] "shift_bits", [39] "rotate_bits", [49] "roll"
case 38, 39, 49 then
if not integer(a2) then
return err_msg(ER_ILLEGAL_ARG, name)
end if
end switch
switch ix do
case 3 then -- [3] "larger_of"
r = larger_of(a1, a2)
case 4 then -- [4] "smaller_of"
r = smaller_of(a1, a2)
case 5 then -- [5] "remainder"
r = remainder(a1, a2)
case 6 then -- [6] "mod"
r = mod(a1, a2)
case 9 then -- [9] "intdiv"
r = intdiv(a1, a2)
case 12 then -- [12] "round"
r = round(a1, a2)
case 19 then -- [19] "atan2"
r = atan2(a1, a2)
case 25 then -- [25] "power"
if a1 < 0 and not integer(a2) then
return err_msg(ER_UNDEFINED_RES, name)
elsif a1 = 0 and a2 < 0 then
return err_msg(ER_DEV_BY_ZERO, name)
elsif a1 = 0 and a2 = 0 then
return err_msg(ER_ILLEGAL_ARG, name)
else
r = power(a1, a2)
end if
case 34 then -- [34] "and_bits"
r = and_bits(a1, a2)
case 35 then -- [35] "xor_bits"
r = xor_bits(a1, a2)
case 36 then -- [36] "or_bits"
r = or_bits(a1, a2)
case 38 then -- [38] "shift_bits"
r = shift_bits(a1, a2)
case 39 then -- [39] "rotate_bits"
r = rotate_bits(a1, a2)
case 40 then -- [40] "gcd"
r = gcd(a1, a2)
case 45 then -- [45] "rand_range"
r = rand_range(a1, a2)
case 48 then -- [48] "chance"
r = chance(a1, a2)
case 49 then -- [49] "roll"
r = roll(a1, a2)
case 50 then -- [50] "compare"
r = compare(a1, a2)
case else
return err_msg(ER_ILLEGAL_ARG, name)
end switch
return r
end function
-- PURPOSE: see calc_func_0().
function calc_func_x(sequence name, integer ix, sequence a)
atom r
integer len = length(a)
if ix = 41 and len = 3 then -- [41] "approx"
r = approx(a[1], a[2], a[3]) -- (no error occurs if a[3] is negative)
else
return err_msg(ER_ILLEGAL_ARG, name)
end if
return r
end function
-- PURPOSE: calculate a function expression and return the result.
-- DETAILS: ix is the function index in FUNC_LIST.
-- 'e' is arguments for function, separated by ",".
-- RETURN: object; result atom or err_msg() string.
-- EXAMPLE: x = calc_func(25, {11, ",", 3}) --> x is 1331
-- SEEALSO: calc_func_0, calc_op, calc_unary_op, calc_expr
function calc_func(integer ix, sequence e)
sequence name = FUNC_LIST[ix], a = arguments_to_sequence(e)
if error_occurred then -- arguments_to_sequence() error.
return err_msg(ER_ILLEGAL_ARG, name)
else
switch length(a) do
case 0 then
return calc_func_0(name, ix)
case 1 then
return calc_func_1(name, ix, a[1])
case 2 then
return calc_func_2(name, ix, a[1], a[2])
case else -- 3+ arguments:
return calc_func_x(name, ix, a)
end switch
end if
end function
-- PURPOSE: calculate an operator expression and return the result.
-- DETAILS: 'e' is expression with two atoms & one operator, e.g. {5, "*", -1}.
-- RETURN: object; result atom or err_msg() string.
-- EXAMPLE: x = calc_op({5, "*", -1.5}) --> x is -7.5
-- SEEALSO: calc_func, calc_unary_op, calc_expr
function calc_op(sequence e)
sequence op = e[2]
atom r, a1, a2
if atom(e[1]) and atom(e[3]) then
a1 = e[1]
a2 = e[3]
else
return err_msg(ER_SYNTAX_ERROR, op)
end if
-- calc operator and two atoms, e.g. {2, "*", 1.5}:
switch find(op, OP_LIST) do -- [index] operator:
case 1 then -- [1] *
r = a1 * a2
case 2 then -- [2] /
if a2 = 0 then
return err_msg(ER_DEV_BY_ZERO, op)
else
r = a1 / a2
end if
case 3 then -- [3] +
r = a1 + a2
case 4 then -- [4] -
r = a1 - a2
case 5 then -- [5] <
r = (a1 < a2)
case 6 then -- [6] >
r = (a1 > a2)
case 7 then -- [7] <=
r = (a1 <= a2)
case 8 then -- [8] >=
r = (a1 >= a2)
case 9 then -- [9] =
r = (a1 = a2)
case 10 then -- [10] !=
r = (a1 != a2)
case 11 then -- [11] and
r = (a1 and a2)
case 12 then -- [12] or
r = (a1 or a2)
case 13 then -- [13] xor
r = (a1 xor a2)
case else
return err_msg(ER_NOT_IMPLEMENTED, op) -- helper for debug.
end switch
return r
end function
-- PURPOSE: calculate all cases of unary-/+ and "not" in expression, only if
-- the next item is an atom.
-- DETAILS: 'e' is expression, see example below.
-- RETURN: sequence; modified expression.
-- NOTE: cases such as -(...) or -func(...) are handled in calc_expr();
-- this function calculates atoms, e.g. '* - 15'; '( + 6'; etc.
-- EXAMPLE: s = calc_unary_op({"-", 5, "*", "-", "(", 6, "/", 2, ")"})
-- --> s is {-5, "*", "-", "(", 6, "/", 2, ")"}
-- SEEALSO: calc_expr, calc_op, calc_func
constant
ST_CHRS = {"(", ","}
function calc_unary_op(sequence e)
integer st, en,
idx = 2,
len = 1 + length(e)
e = {"+"} & e -- temporarily prepend an operator.
-- calculate unary-/+/not and one atom each loop, e.g. {"*", "-", 15}:
while idx < len do
if sequence(e[idx]) then
if find(e[idx], UNARY_OP_LIST) then
st = idx - 1
en = idx + 1
if sequence(e[st]) and atom(e[en]) then
if find(e[st], OP_LIST & ST_CHRS) then
switch e[idx] do
case "-" then
e[en] = -e[en]
case "not" then
e[en] = not e[en]
-- case "+" then
-- just remove the sign.
end switch
-- remove the sign:
e = remove(e, idx) -- ! Euphoria 3: e = e[1..st] & e[en..$]
len -= 1
end if
end if
end if
end if
idx += 1
end while
-- remove temporarily prepended operator:
return tail(e) -- ! Euphoria 3: return e[2..$].
end function
-- MAIN =====================================================================
-- PURPOSE: calculate a full expression and return the result.
-- DETAILS: 'e' sequence is returned by parse_expr().
-- RETURN: sequence; result atom, e.g. {-2.5}; or err_msg() string.
-- NOTE: expressions are evaluated from left-to-right, using Euphoria's
-- precedence order (see PRECEDENCE_LISTS constant).
-- EXAMPLE: s = calc_expr({1, "+", 2, "*", {FUNC_ID, 1}, "(", -11, ")"})
-- --> s is {23}
-- i.e. s is {1 + 2 * abs(-11)}
-- SEEALSO: parse_expr, math_eval, calc_op, calc_unary_op, calc_func
function calc_expr(sequence e)
integer st, en, idx
object obj
-- make sure expression enclosed with parenthesis to get final result;
e = {"("} & e & {")"}
-- calculate all expressions found within parenthesis (precedence-1):
while TRUE do
-- find the most inner ")":
en = find(")", e)
if en = 0 then
if find("(", e) then
return err_msg("Missing ')'")
else
exit
end if
end if
-- find the most inner "(":
st = 0
for i = en - 1 to 1 by -1 do
if equal(e[i], "(") then
st = i
exit
end if
end for
if st = 0 then
return err_msg("Missing '('")
end if
-- calculate chunks of the expression according to precedence order;
-- the idea is to shrink each chunk into atom, e.g. 5 * 10 --> 50:
for precedence = 4 to 7 do
idx = st + 1
while idx < en do
if atom(e[idx]) then -- atom can't be operator...
idx += 1
elsif find(e[idx], PRECEDENCE_LISTS[precedence]) then
obj = calc_op(e[idx - 1..idx + 1])
-- remove two atoms and operator; keep only new atom:
if atom(obj) then
-- ! Euphoria 3: e = e[1..idx - 2] & obj & e[idx + 2..$]
e = replace(e, obj, idx - 1, idx + 1)
en -= 2
else
return obj -- return err_msg()
end if
else
idx += 1
end if
end while
end for -- precedence
-- helper for debug:
if not (equal(e[st], "(") and equal(e[en], ")")) then
return err_msg(ER_BUG_IN_CODE, "calc_expr")
-- first: calculate a function using the result atom(s), or
-- calculate a function without arguments such as rnd():
elsif st > 1 and sequence(e[st - 1]) and e[st - 1][1] = FUNC_ID then
obj = calc_func(e[st - 1][2], e[st + 1..en - 1])
-- remove the function-id and (); keep only result atom:
if atom(obj) then
-- ! Euphoria 3: e = e[1..st - 2] & obj & e[en + 1..$]
e = replace(e, obj, st - 1, en)
else
return obj -- return err_msg()
end if
-- then: operator result must be a single atom:
elsif st + 2 = en and atom(e[st + 1]) then
-- remove the () and keep only the result atom:
-- ! Euphoria 3: e = e[1..st - 1] & e[st + 1] & e[en + 1..$]
e = replace(e, e[st + 1], st, en)
-- when only () remains:
elsif st + 1 = en then
return err_msg("Missing expression inside", "( )")
-- invalid syntax returned inside ( ), e.g. "1not-2" or "(1not-2)":
else
if st = 1 then -- the first '(' is prefixed to the expression.
return err_msg(ER_SYNTAX_ERROR & " expression")
else
return err_msg(ER_SYNTAX_ERROR, "( )")
end if
end if
-- finally, re-calc unary+/-/not for atoms, since the ( ) and
-- function name removed, i.e. for -(1 + 2) or -abs(4), etc:
e = calc_unary_op(e)
end while -- found expression within parenthesis
return e
end function
-- PURPOSE: parse string expression into a sequence of initial arguments.
-- DETAILS: expr, var_names, var_values are same as in function math_eval().
-- get_id = TRUE used by get_identifiers() to keep identifier names.
-- RETURN: sequence; sequence of arguments, or err_msg() string.
-- * if get_id = TRUE then arguments are only identifiers *names*.
-- EXAMPLE: s = parse_expr("( a + 5 * abs(c) )", {"a", "c"}, {11.2, -4})
-- --> s is {"(", 11.2, "+", 5, "*", {'@', 1}, "(", -4, ")", ")"}
-- SEEALSO: math_eval, get_identifiers, calc_unary_op, calc_expr,
-- string_to_number
function parse_expr(ascii_string expr, sequence var_names, sequence var_values,
boolean get_id = FALSE)
integer idx, chr, st, en, func_ix
sequence str, e = {}, id = {}
object get_value
atom num
-- NUL is end-of-string marker and placeholder for 'next-chr':
expr &= NUL
-- parse expression into sequence:
idx = 1
while TRUE do
chr = expr[idx]
-- first check for end-of-string marker:
if chr = NUL then
exit
-- ignore and skip blanks and control characters ('\t', etc):
elsif chr <= 32 or chr = 127 then
idx += 1
-- append parenthesis, comma, and symbolic operators:
elsif find(chr, "(),*/+-=<>!") then
if expr[idx + 1] = '=' and find(chr, "<>!") then
-- append ambiguous operators "<=", ">=", "!=":
e = append(e, chr & '=')
idx += 2
else
e = append(e, {chr})
idx += 1
end if
-- get and append number's value, e.g. 10.5 (# for hexadecimal):
elsif (chr >= '0' and chr <= '9') or chr = '.' or chr = '#' then
st = idx
en = idx
idx += 1
while TRUE do
chr = expr[idx]
if (chr >= '0' and chr <= '9') or
(chr >= 'a' and chr <= 'z') or
(chr >= 'A' and chr <= 'Z') or chr = '.' or chr = '_' or
((chr = '-' or chr = '+') and find(expr[idx - 1], "eE"))
then
en = idx
idx += 1
else
get_value = string_to_number(expr[st..en])
if atom(get_value) then
e = append(e, get_value)
exit
else
return err_msg("Invalid number", expr[st..en], st)
end if
end if
end while
-- get and append variable's/constant's value, operator's string,
-- and function's index:
elsif (chr >= 'a' and chr <= 'z') or
(chr >= 'A' and chr <= 'Z') or chr = '_'
then
st = idx
en = idx
idx += 1
while TRUE do
chr = expr[idx]
if (chr >= 'a' and chr <= 'z') or
(chr >= 'A' and chr <= 'Z') or
(chr >= '0' and chr <= '9') or chr = '_'
then
en = idx
idx += 1
else
str = expr[st..en]
-- get_identifiers() keeps identifier name (not value):
if get_id then
id = append(id, str)
-- append the value of variable:
elsif find(str, var_names) then
num = var_values[find(str, var_names)]
e = append(e, num)
-- append the value of constant:
elsif find(str, CONST_LIST) then
num = CONST_LIST_VALUES[find(str, CONST_LIST)]
e = append(e, num)
-- append operator string ("and", "or", "xor", "not"):
elsif find(str, OP_LIST) then
e = append(e, str)
-- append the index of function, e.g. {'@', 15}:
else
func_ix = find(str, FUNC_LIST)
if func_ix then
e = append(e, {FUNC_ID, func_ix})
else
return err_msg("Invalid identifier", str, st)
end if
end if
exit
end if
end while
-- unsupported character found, such as '&':
else
return err_msg("Invalid character", {chr}, idx)
end if
end while -- idx
-- get_identifiers() needs only the identifiers names:
if get_id then
return id
-- math_eval() needs the parsed expression:
else
-- do the initial unary+/-/not calculation for atoms, e.g. {"-", 15};
-- note that -(1 + 2) or -abs(4), etc, is handled in calc_expr():
e = calc_unary_op(e)
return e
end if
end function
-- PUBLIC FUNCTIONS =========================================================
-- PURPOSE: evaluate a math expression. see "math_eval.doc" user manual.
-- DETAILS: expr is any Euphoria math expression string - see example below.
-- use_deg is FALSE=Radians/TRUE=Degrees for trigonometry functions.
-- var is optional variables sequences {{...}, {...}}:
-- var[1] is var_names, it's the variable names;
-- var[2] is var_values, it's paralleled to var_names, as it is the
-- variable's value, which is an atom or a string-expression
-- representing an atom, e.g.:
-- var = { {"R", "Si" , "tol", "fact"} --> [1] var_names
-- {6 , "-(abs(-1))", 12.5 , ".3"} } --> [2] var_values
-- INPUT: error_occurred
-- OUTPUT: use_degrees
-- RETURN: object; atom as result, or err_msg() string.
-- EXAMPLE: x = math_eval("( a + 5 * abs(c) )", 0, {{"a", "c"}, {11.2, -4}})
-- --> x is 31.2
-- i.e. x is (11.2 + 5 * abs(-4))
-- SEEALSO: get_identifiers, parse_expr, calc_expr, err_msg, set_local_variables
public function math_eval(ascii_string expr, boolean use_deg = FALSE,
paralleled_seq var = {{}, {}})
object e
seq_of_strings var_names = var[1]
seq_of_values var_values = var[2]
set_local_variables(ON_ENTER)
-- convert strings in 'var_values' to atoms, e.g. "-1.5*2" --> -3:
for i = 1 to length(var_names) do
var_names[i] = trim(var_names[i]) -- ( trim() works per *string* ).
if find(var_names[i], FUNC_LIST & CONST_LIST & OP_LIST) then
e = err_msg("Illegal variable name", var_names[i])
exit
elsif sequence(var_values[i]) then
-- (this supports also previous variables in a string-expression):
e = math_eval(var_values[i], use_deg, {
head(var_names, i - 1), -- ! Euphoria 3: var_names[1..i - 1],
head(var_values, i - 1) -- ! Euphoria 3: var_values[1..i - 1]
})
if atom(e) then
var_values[i] = e
else -- e = err_msg(...):
-- ! Euphoria 3: tail(e) is e[2..$]
e = ERR_MSG_HEAD & "'" & var_names[i] & "': " & tail(e)
exit
end if
end if
end for
if error_occurred then
-- e = err_msg(...)
-- parse 'expr' to its initial arguments:
else
e = parse_expr(expr, var_names, var_values)
if error_occurred then
-- e = err_msg(...)
elsif length(e) = 0 then
e = err_msg("Empty expression")
-- calculate the expressions:
else
use_degrees = use_deg -- output to local variable
e = calc_expr(e)
if error_occurred then
-- e = err_msg(...)
elsif length(e) = 1 then
e = e[1] -- the final result must be a single atom
else
e = err_msg(ER_BUG_IN_CODE, "math_eval") -- helper for debug
end if
end if
end if
-- return atom as result; or error message string:
set_local_variables(ON_EXIT)
return e
end function
-- PURPOSE: extract alphanumeric identifiers from a string expression.
-- - it can be useful for getting variable names, which is the
-- default behavior, and prompt the user for their values.
-- DETAILS: expr is same as in function math_eval().
-- list is the identifier-list to return, or all of them.
-- INPUT: error_occurred
-- RETURN: sequence; A sequence of length two consisting of:
-- * an integer, the return status. This is any of:
-- GET_ID_SUCCESS -- expression was read successfully
-- GET_ID_FAIL -- expression is not syntactically correct
--
-- * - if GET_ID_SUCCESS: a sequence which contains 4 sub-sequences
-- for each type of identifier; or a sequence which contains
-- only one type of identifier. see public indexes below.
-- - if GET_ID_FAIL: err_msg() string.
-- EXAMPLE: s = get_identifiers("( PI / not a + 5 * abs(c) )", GET_ID_ALL)
-- --> s is {GET_ID_SUCCESS, {{"not"}, {"abs"}, {"PI"}, {"a", "c"}}}
-- SEEALSO: math_eval, parse_expr, set_local_variables
public constant
-- return status integers:
GET_ID_SUCCESS = 0, -- expression was read successfully
GET_ID_FAIL = 1 -- expression is not syntactically correct
public constant
-- return sequence indexes (list) - from 1 to 4:
GET_ID_ALL = 0,
GET_ID_OPERATORS = 1,
GET_ID_FUNCTIONS = 2,
GET_ID_CONSTANTS = 3,
GET_ID_VARIABLES = 4
public function get_identifiers(ascii_string expr, integer list = GET_ID_VARIABLES)
sequence e, id = repeat({}, 4)
object str
integer idx
set_local_variables(ON_ENTER)
-- parse expression and keep the identifier names (not values):
e = parse_expr(expr, {}, {}, TRUE)
-- id is err_msg():
if error_occurred then
id = {GET_ID_FAIL, e}
-- id is identifiers list(s):
else
e = remove_dups_inplace(e) -- remove duplicate identifiers
-- store identifier names in 'id':
for i = 1 to length(e) do
str = e[i]
if find(str, OP_LIST) then -- operator name, e.g. "or"
idx = GET_ID_OPERATORS
elsif find(str, FUNC_LIST) then -- function name, e.g. "abs"
idx = GET_ID_FUNCTIONS
elsif find(str, CONST_LIST) then -- constant name, e.g. "PI"
idx = GET_ID_CONSTANTS
else -- variable name, e.g. "xyz"
idx = GET_ID_VARIABLES
end if
id[idx] = append(id[idx], str) -- append identifier to list
end for
-- id is all lists, or just a single list:
if list != GET_ID_ALL then
id = id[list]
end if
id = {GET_ID_SUCCESS, id}
end if
-- return success or fail sequence:
set_local_variables(ON_EXIT)
return id
end function
-- End of file.