Question

这与问题密切相关：How do I pass ``...`` to a new environment in R?

线程here。

我的最终目标是能够拥有以下功能：

对函数进行操作并返回函数
return函数创建一个以.GlobalEnv作为其父
它评估新环境中的参数函数。
它解决了下面描述的保存大小问题。

保存大小问题是lm（以及其他，例如ggplot）对象保存其调用环境的问题，这些环境通常包含无关信息。目标是有一个方便的包装器来解决这个问题。为了证明：

saveSize <- function (object) {
  tf <- tempfile(fileext = ".RData")
  on.exit(unlink(tf))
  save(object, file = tf)
  file.size(tf)
}

tmp_fun <- function(){
  iris_big <- lapply(1:10000, function(x) iris)
  lm(Sepal.Length ~ Sepal.Width, data = iris)
}

out <- tmp_fun()
object.size(out)
# 48008
saveSize(out)
# 1002448 - Far too large as it contains iris_big.

Bill Dunlap提出了这个有效的解决方案：

tmp_fun_Bill <- function(){
  iris_big <- lapply(1:10000, function(x) iris)
  env <- new.env(parent = globalenv())
  with(env, lm(Sepal.Length ~ Sepal.Width, data = iris))
}

out <- tmp_fun_Bill()
object.size(out)
# 48008
saveSize(out)
# 4478 - this works!

我想将Bill的方法概括为其中一个返回函数的函数（如purrr::safely）。

我最好的尝试，在@MrFlick的帮助下：

in_new_env <- function(.f){
  function(...) {
    params <- list(...)
    env <- new.env(parent = globalenv())
    # Change the environment of any formula objects
    params <- lapply(params, function(x) {if (inherits("x","formula")) {environment(x)<-env}; x})
    assign(".params.", params, envir = env)
    env$.f <- .f
    evalq(do.call(".f", .params.), envir=env)
  }
}

tmp_fun_me <- function(){
  iris_big <- lapply(1:10000, function(x) iris)
  in_new_env(lm)(Sepal.Length ~ Sepal.Width, data = iris)
}

out <- tmp_fun_me()
object.size(out)
# 48008
saveSize(out)
# 1002448 - too big again

有人可以指出这里出了什么问题吗？

Answer 1

问题实际上是公式抓住了当前的环境。这是一个将公式环境设置为空环境的函数

dropenv <- function(x) {
    env <- new.env(parent = globalenv())
    if (inherits(x,"formula")) {
        environment(x)<-env
    }
    x
}

tmp_fun_drop <- function(){
    iris_big <- lapply(1:10000, function(x) iris)
    lm(dropenv(Sepal.Length ~ Sepal.Width), data = iris)
}

但是这需要对lm()函数进行公式参数的调整和解析。这是您所需方法调用的可能解决方法

in_new_env <- function(.f){
  function(formula, ...) {
    formula <- dropenv(formula)
    .f(formula, ...)
  }
}

tmp_fun_drop <- function(){
  iris_big <- lapply(1:10000, function(x) iris)
  in_new_env(lm)(Sepal.Length ~ Sepal.Width, data = iris)
}

现在in_new_env返回的函数假定第一个参数是公式，并清除该公式的环境。

如何编写一个副词函数来返回在不同环境中评估的函数？

1 个答案: