将公式/运算符解释为函数

Question

在 R 中是否可以将自定义函数分配给数学运算符（例如 *、+）或将 as.formula() 提供的公式解释为评估指令？

具体来说，我希望将* 解释为intersect()，并将+ 解释为c()，因此R 将评估表达式

(a * (b + c)) * d) 或 myfun(as.formula('~(a * (b + c)) * d)'), list(a, b, c, d))

作为

intersect(intersect(a, c(b, c)), d)

我可以使用gsub()ing 在while() 循环中以字符串形式提供的表达式产生相同的结果，但我想这远非完美。

编辑：我错误地发布了sum() 而不是c()，所以一些答案可能是指问题的未编辑版本。

示例：

############################
## Define functions

var <- '[a-z\\\\{\\},]+'
varM <- paste0('(', var, ')')
varPM <- paste0('\\(', varM, '\\)')

## Strip parentheses
gsubP <- function(x) gsub(varPM, '\\1', x)

## * -> intersect{}
gsubI <- function(x) {
    x <- gsubP(x)
    x <- gsub(paste0(varM, '\\*', varM), 'intersect\\{\\1,\\2\\}', x)
    return(x)
}

## + -> c{}
gsubC <- function(x) {
    x <- gsubP(x)
    x <- gsub(paste0(varM, '\\+', varM), 'c\\{\\1,\\2\\}', x)
    return(x)
}

############################
## Set variables and formula
a <- 1:10
b <- 5:15
c <- seq(1, 20, 2)
d <- 1:5

string <- '(a * (b + c)) * d'


############################
## Substitute formula

string <- gsub(' ', '', string)

while (!identical(gsubI(string), string) || !identical(gsubC(string), string)) {
    while (!identical(gsubI(string), string)) {
        string <- gsubI(string)
    }
    string <- gsubC(string)
}

string <- gsub('{', '(', string, fixed=TRUE)
string <- gsub('}', ')', string, fixed=TRUE)


## SHAME! SHAME! SHAME! ding-ding
eval(parse(text=string))

Answer 1

你可以这样做：

 `*` <- intersect
 `+` <- c

请注意，如果您在全局环境（不是函数）中执行此操作，则可能会使脚本的其余部分失败，除非您打算让 * 和 + 始终进行求和和截取。其他选项是使用 S3 方法和类来限制这种使用。

* 和 + 在公式中具有特殊含义，因此我认为您不能覆盖它。但是您可以使用公式作为传递未经评估的表达式的方式，根据@MrFlick 的回答。

Answer 2

公式实际上只是一种保存未计算表达式的方法。您可以创建一个重新定义这些函数的环境，然后在该环境中评估该表达式。这是一个可以为您完成大部分工作的函数。首先，您的示例输入

a <- 1:10
b <- 5:15
c <- seq(1, 20, 2)
d <- 1:5

现在的功能

myfun <- function(x, env=parent.frame()) {
    #check the formula
    stopifnot("formula" %in% class(x), length(x)==2)

    #redefine functions
    funcs <- list2env(list(
        `+`=base::c, 
        `*`=base::intersect
    ), parent=env)
    eval(x[[2]], funcs)
}

我们会用它来称呼它

myfun( ~(a * (b + c)) * d )
# [1] 1 3 5

这里我们从当前环境中获取变量值，如果你愿意，我们也可以将它们作为参数传递

myfun <- function(x, ..., .dots=list()) {
    #check the formula
    stopifnot("formula" %in% class(x), length(x)==2)

    #check variables
    dotraw <- sapply(substitute(...()), deparse)
    dots <- list(...)
    if(length(dots) && is.null(names(dots))) names(dots)<-dotraw
    dots <- c(dots,.dots)
    stopifnot(all(names(dots)!=""))

    #redefine functions
    funcs <- list2env(list(
        `+`=base::c, 
        `*`=base::intersect
    ), parent=parent.frame())
    eval(x[[2]], dots, funcs)
}

那你就可以了

myfun( ~(a * (b + c)) * d , a, b, c, d)
myfun( ~(a * (b + c)) * d , a=b, b=a, c=d, d=c)
myfun( ~(a * (b + c)) * d , .dots=list(a=a, b=b, c=c, d=d))
myfun( ~(a * (b + c)) * d , .dots=mget(c("a","b","c","d")))