将 formulae/operators 解释为函数
Interpret formulae/operators as functions
是否可以在 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()
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))
你可以这样做:
`*` <- intersect
`+` <- c
请注意,如果您在全局环境(不是函数)中执行此操作,则可能会使脚本的其余部分失败,除非您打算让 * 和 + 始终执行求和和截取。其他选项是使用 S3 方法和 类 来限制该用法。
*
和 +
在公式中具有特殊含义,因此我认为您无法覆盖它。但是您可以使用公式作为按照@MrFlick 的回答传递未计算表达式的方式。
公式实际上只是一种保存未计算表达式的方法。您可以创建一个重新定义这些函数的环境,然后在该环境中计算该表达式。这是一个可以为您完成大部分工作的函数。首先,您的样本输入
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")))
是否可以在 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()
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))
你可以这样做:
`*` <- intersect
`+` <- c
请注意,如果您在全局环境(不是函数)中执行此操作,则可能会使脚本的其余部分失败,除非您打算让 * 和 + 始终执行求和和截取。其他选项是使用 S3 方法和 类 来限制该用法。
*
和 +
在公式中具有特殊含义,因此我认为您无法覆盖它。但是您可以使用公式作为按照@MrFlick 的回答传递未计算表达式的方式。
公式实际上只是一种保存未计算表达式的方法。您可以创建一个重新定义这些函数的环境,然后在该环境中计算该表达式。这是一个可以为您完成大部分工作的函数。首先,您的样本输入
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")))