R - 使用非标准评估检查字符串是否是有效的数学表达式

Question

我想检查下面的字符串是否是有效的数学表达式:

s1 = 'sin(x)'
s2 = 'sin(x*m)'
s3 = 'sin'
s4 = 'sin(xm)'

“有效”是指表达式是

的组合

1. 运算符(必须与变量或常量结合使用)
2. 变量 x 和/或 m
3. 常量。

根据这个定义，s1 和 s2 是有效的，而 s3 和 s4 不是。

为了确定字符串是否有效，我编写了一个函数 checkFxn，它首先尝试将字符串转换为调用或其一部分。如果成功，它将遍历调用树并检查上述条件。如果满足条件，则调用按原样返回。否则，将引发错误。

checkFxn <- function(x) {

  lang <- str2lang(x)

  checkFxn2 <- function(y) {

    if(is.name(y)) {

      stopifnot(deparse(y) %in% c('x', 'm'))

    } else if(is.call(y)) {

      stopifnot(is.function(eval(y[[1]])) | is.primitive(eval(y[[1]])))

      lapply(y[-1], checkFxn2)

    } else {

      stopifnot(is.logical(y) | is.numeric(y) | is.complex(y))

    }

    return(y)

  }

  checkFxn2(lang)

}


#Applying checkFxn to s1-4
lapply(list(s1,s2,s3,s4), function(x) {try(checkFxn(x), silent = T)})
[[1]]
sin(x)

[[2]]
sin(x * m)

[[3]]
[1] "Error in checkFxn2(lang) : deparse(y) %in% c(\"x\", \"m\") is not TRUE\n"
attr(,"class")
[1] "try-error"
attr(,"condition")
<simpleError in checkFxn2(lang): deparse(y) %in% c("x", "m") is not TRUE>

[[4]]
[1] "Error in FUN(X[[i]], ...) : deparse(y) %in% c(\"x\", \"m\") is not TRUE\n"
attr(,"class")
[1] "try-error"
attr(,"condition")
<simpleError in FUN(X[[i]], ...): deparse(y) %in% c("x", "m") is not TRUE>

它似乎按预期工作，但我对使用 eval 持谨慎态度，想知道是否有人可以建议使用它的替代方法？我知道它遵循通常的词法范围规则，所以我担心它在全局环境中评估变量——有没有办法限制它的范围？我读过关于 non-standard evaluation 的章节但我想不通。

还有，有没有办法识别基函数或原语是否是数学运算符？我想使用比 is.function 和 is.primitive 更具体的东西。

Answer 1

第 1 步:确定什么是“数学运算符”。一种选择是从 S4 generics 检索相关组.例如，

mathOps <- unlist(lapply( c("Arith","Compare","Math"), getGroupMembers ))
#  [1] "+"        "-"        "*"        "^"        "%%"       "%/%"     
#  [7] "/"        "=="       ">"        "<"        "!="       "<="      
# [13] ">="       "abs"      "sign"     "sqrt"     "ceiling"  "floor"   
# [19] "trunc"    "cummax"   "cummin"   "cumprod"  "cumsum"   "exp"     
# [25] "expm1"    "log"      "log10"    "log2"     "log1p"    "cos"     
# [31] "cosh"     "sin"      "sinh"     "tan"      "tanh"     "acos"    
# [37] "acosh"    "asin"     "asinh"    "atan"     "atanh"    "cospi"   
# [43] "sinpi"    "tanpi"    "gamma"    "lgamma"   "digamma"  "trigamma"

第 2 步:将您的表达式分解为 abstract syntax trees .

getAST <- function( ee ) 
    lapply( as.list(ee), function(x) `if`(is.call(x), getAST(x), x) )

# Example usage
getAST( quote(sin(x+5)) )
# [[1]]
# sin
# 
# [[2]]
# [[2]][[1]]
# `+`
# 
# [[2]][[2]]
# x
# 
# [[2]][[3]]
# [1] 5

第 3 步:根据您对“有效性”的定义遍历 AST

checkFxn <- function( ast, validOps )
{
  ## Terminal nodes of an AST will not be lists
  ## Wrap them into a list of length 1 to keep the recursion flow
  if( !is.list(ast) ) ast <- list(ast)

  ## Operators must be called with one or more arguments
  if( as.character(ast[[1]]) %in% validOps )
    return( `if`(length(ast) < 2, FALSE,
                 all(sapply(ast[-1], checkFxn, validOps))) )

  ## Variables x and m are OK
  if( identical(ast[[1]], quote(x)) || identical(ast[[1]], quote(m)) )
    return(TRUE)

  ## Constants are OK
  if( is.numeric(ast[[1]]) ) return(TRUE)

  ## Everything else is invalid
  FALSE
}

将它们放在一起

exprs <- lapply( list(s1,s2,s3,s4), str2lang )   # Convert strings to expressions
asts <- lapply( exprs, getAST )                  # Build ASTs
sapply( asts, checkFxn, mathOps )                # Evaluate validity
# [1]  TRUE  TRUE FALSE FALSE 

AST 的替代品

正如@Moody_Mudskipper 所指出的，还可以使用 all.names 来检索出现在任意表达式中的符号列表。虽然这不会保留这些符号的相对结构，但可以将名称直接与 mathOps 进行比较。