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

Let's say I have an object of type "symbol" representing the name of a function. For example:

nm <- quote(mean)

I want to construct a function f whose body uses the function named by the symbol nm. For example:

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

I want to construct this function identically, which implies that I would not be satisfied with the following approach:

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)

since the body of g is not body(f) and the environment of g is not environment(f).

One approach that I've considered is bquote:

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

bquote gets me most of the way there, but one issue is that the print output of h doesn't contain the substituted value of nm by default:

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)
## }

The cause seems to be the srcref attribute of h:

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

My question is: How might one approach the general problem of constructing f from nm?

My conditions on the constructed function h are that identical(f, h) should be TRUE and that the output of print(h) should contain the substituted value of nm, similar to print(f).

I would welcome answers improving on my existing bquote approach, or answers suggesting a new approach, or answers explaining why what I want to do is not actually possible...

CodePudding user response：

Not especially elegant, but a parse(deparse( seems to work:

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 is not identical, as expected:

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] "}"

CodePudding user response：

Reading through ?srcref, it seems that there are two idiomatic ways to improve the bquote approach. The first uses removeSource to recursively clean a function that preserves its source code:

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)
}

The second avoids preserving the source code altogether:

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)
}

Actually, ?options states that the default value of keep.source is interactive(), so both approaches are somewhat redundant in non-interactive contexts.