使用 '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] "}"

Answer 2

通读 ?srcref，似乎有两种惯用的方法可以改进 bquote 方法。第一个使用 removeSource 递归清理保留其源代码的函数：

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

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

第二种完全避免保留源代码：

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

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

实际上，?options 指出 keep.source 的默认值是 interactive()，因此这两种方法在非交互式上下文中都有些多余。

使用 'bquote'（或替代方法）从符号构造函数

Constructing functions from symbols using 'bquote' (or alternatives to doing so)

r

metaprogramming

function