是否有可能有'dput'返回的源代码，将在封闭的环境之外运行？

Question

假设我有一个闭包addy（y），它返回一个函数，将y添加到它的输入中。

add_y <- function(y) {
  function(x) {
    x + y
  }
}
add_4 <- add_y(4)

因此，add_4的值是一个将4添加到其输入的函数。这很有效。我想使用dput将add_4的定义显示为

function(x) {
  x + 4
}

但这不是dput返回的结果。

add_y <- function(y) {
  function(x) {
    x + y
  }
}
add_4 <- add_y(4)
dput(add_4)
#> function (x) 
#> {
#>     x + y
#> }

有没有办法获得在封闭环境之外运行的源代码？

Answer 1

您可以构建一个dput替换生成的代码，该代码创建类似于add_4的函数，但它不会偏离您想要的方式：

dput_with_env <- function(f) {
  fn <- deparse(f, control = c("keepNA", "keepInteger", 
                               "niceNames", "showAttributes"))
  env <- as.list(environment(f))
  cat("local({ f =\n")
  cat(fn, sep = "\n")
  cat("\nenvironment(f) <- list2env(\n")
  dput(env)
  cat(")\nf})")
}

add_y <- function(y) {
  function(x) {
    x + y
  }
}
add_4 <- add_y(4)

dput_with_env(add_4)
#> local({ f =
#> function (x) 
#> {
#>     x + y
#> }
#> 
#> environment(f) <- list2env(
#> list(y = 4)
#> )
#> f})

^{由reprex软件包（v2.0.1）于2021年12月24日创建}

这假定add_4的环境非常简单，因此在评估代码时，其环境的父环境可以是适当的环境。我们可以试试：

newfn <- local({ f =
function (x) 
{
   x + y
}
environment(f) <- list2env(
list(y = 4)
)
f})

newfn
#> function (x) 
#> {
#>    x + y
#> }
#> <environment: 0x7f9a1b5e2318>
newfn(1)
#> [1] 5

^{由reprex软件包（v2.0.1）于2021年12月24日创建}

Answer 2

这是可行的，但它涉及到更改add\y的内容。

library(rlang)
library(magrittr)
library(stringr)

add_y <- function(y) {
  fn <- expr(function(x) {
    x+!!y
  })
  fn <- deparse(fn) %>% str_c(collapse = "")
  fn <- eval(parse(text = fn))
}

add_4 <- add_y(4)

dput(add_4)
#> function (x) 
#> {
#>     x + 4
#> }

^{由reprex软件包（v2.0.1）于2021年12月24日创建}

Answer 3

如果您控制add_y，那么一种解决方法是将y的值直接注入内部函数的主体中，或者将其注入正式参数列表中。这消除了环境的使用，因此问题不再存在。这涉及到命名匿名内部函数，并且只有一个额外的行来执行注入，外加一行来返回结果。

# 1. inject into body
add_y2 <- function(y) {
  inner <- function(x) {
    x + y
  }
  body(inner) <- do.call("substitute", list(body(inner)))
  inner
}
# test
add_4 <- add_y2(4)
dput(add_4)
## function (x) 
## {
##     x + 4
## }

# 2. inject into formal arguments
add_y3 <- function(y) {
  inner <- function(x) {
    x + y
  }
  formals(inner)$y <- y
  inner
}
# test
add_4 <- add_y3(4)
dput(add_4)
## function (x, y = 4) 
## {
##     x + y
## }