r - 使用 'bquote'(或替代方法)从符号构造函数

Question

假设我有一个“symbol”类型的对象，表示一个函数的名称。例如:

nm <- quote(mean)

我想构造一个函数f，其主体使用由符号nm 命名的函数。例如:

f <- function(x, do = c("something", "nothing")) {
  switch(match.arg(do), something = mean(x), nothing = x)
}

我想以相同的方式构造此函数，这意味着我不对以下方法感到满意:

factory <- function(name) {
  func <- match.fun(name)
  function(x, do = c("something", "nothing")) {
    switch(match.arg(do), something = func(x), nothing = x)
  }
}
g <- factory(nm)

因为 g 的主体不是 body(f) 而 g 的环境不是 environment(f).

我考虑过的一种方法是 bquote:

h <- eval(bquote({
  function(x, do = c("something", "nothing")) {
    switch(match.arg(do), something = .(nm)(x), nothing = x)
  }
}))

bquote 让我了解了大部分内容，但一个问题是 h 的 print 输出不包含替换值nm 默认:

h
## function(x, do = c("something", "nothing")) {
##     switch(match.arg(do), something = .(nm)(x), nothing = x)
##   }

print(h, useSource = FALSE)
## function (x, do = c("something", "nothing")) 
## {
##     switch(match.arg(do), something = mean(x), nothing = x)
## }

原因似乎是h的srcref属性:

identical(f, h)
## [1] TRUE
identical(f, h, ignore.srcref = FALSE)
## [1] FALSE

我的问题是:如何解决从 nm 构造 f 的一般问题？

我对构造函数 h 的条件是 identical(f, h) 应该是 TRUE 并且 的输出print(h) 应包含 nm 的替换值，类似于 print(f)。

我欢迎改进我现有的 bquote 方法的答案，或者建议新方法的答案，或者解释为什么我想做的事情实际上不可能的答案......

Answer 1

不是特别优雅，但是 parse(deparse( 似乎可行:

nm <- quote(mean)
f <- function(x, do = c("something", "nothing")) {
  switch(match.arg(do), something = mean(x), nothing = x)
}

eval(parse(text=deparse(bquote(h <- function(x, do = c("something", "nothing")) {
  switch(match.arg(do), something = .(nm)(x), nothing = x)
}))))

identical(f, h)
#> [1] TRUE
print(f)
#> function(x, do = c("something", "nothing")) {
#>   switch(match.arg(do), something = mean(x), nothing = x)
#> }
print(h)
#> function(x, do = c("something", "nothing")) {
#>     switch(match.arg(do), something = mean(x), nothing = x)
#> }

srcref 与预期的不同:

identical(f, h, ignore.srcref = FALSE)
#> [1] FALSE
attributes(attributes(f)$srcref)$srcfile$lines
#> [1] "f <- function(x, do = c(\"something\", \"nothing\")) {"     
#> [2] "  switch(match.arg(do), something = mean(x), nothing = x)"
#> [3] "}"
attributes(attributes(h)$srcref)$srcfile$lines
#> [1] "h <- function(x, do = c(\"something\", \"nothing\")) {"     
#> [2] "    switch(match.arg(do), something = mean(x), nothing = x)"
#> [3] "}"