是否可以讓 `dput` 返回在封閉環境之外運行的源代碼？

Question

假設我有一個閉包add_y(y) ，它返回一個 function ，它將y添加到其輸入中。

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

所以add_4的值是一個 function ，它的輸入加 4。 這行得通。 我想使用 dput 將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

這可以工作，但它涉及更改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
#> }

^{由代表 package (v2.0.1) 於 2021 年 12 月 24 日創建}

Answer 2

您可以構建一個dput替換，該替換生成的代碼創建一個 function 就像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})

^{由代表 package (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

^{由代表 package (v2.0.1) 於 2021 年 12 月 24 日創建}

Answer 3

沒有dput() ，不。 dput() function 不會創建環境的文本表示。

如果你想保存 function，你可以這樣做

save(add_4, file="add4.Rdata")

然后在另一個 R session

load("add4.Rdata")

這將捕獲所有封閉的值，並且您的 function 將像以前一樣運行

Answer 4

如果您控制 add_y 那么解決方法是將 y 的值直接注入內部 function 的主體中，或者將其注入正式參數列表中。 這消除了環境的使用，因此問題不再存在。 這涉及到命名匿名內部 function 並且只有一行額外的行來執行注入加上一行來返回結果。

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