Question

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

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

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

AS

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

我可以使用gsub()在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")))

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

实施例

2 个答案: