如何让嵌套函数中生成的对象被内部生成函数调用（R语言）

问题背景 #

需要编写函数f，在其中调用第三方包的函数j；j会调用同包的h生成一个函数并执行它。g是f内部定义的函数，需被h使用，但受j的接口限制，只能以名称"g"传递给j。执行原代码时出现错误：找不到函数"g"，因为g不在h生成函数的闭包环境中。已知不能修改j和h，且不想将g赋值到全局环境。

原示例代码：

f <- function() {
    g <- function() {
        10
      }
    j(g_name = "g")
  }

j <- function(g_name) {
    out <- h(g_name = g_name)
    cat("The body of `out`\n")
    print(body(out))
    cat("Call out:\n")
    out()
  }

h <- function(g_name) {
    out <- function() NULL
    body_str <- paste0(g_name, "()")
    body(out) <- parse(file = "",
                       text = body_str)
    out
  }

z <- f()
#> The body of `out`
#> g()
#> Call out:
#> Error in g(): could not find function "g"

解决方案 #

方案一：利用trace临时注入环境 #

修改f函数，通过trace在h生成函数后，将f环境中的g注入到生成函数的闭包环境中：

f <- function() {
    g <- function() {
        10
      }
    # 临时在h函数末尾插入代码，注入g到out的环境
    trace(h, quote({
        environment(out)$g <- get("g", envir = parent.frame())
    }), at = length(body(h)))
    # 调用j
    result <- j(g_name = "g")
    # 移除trace，恢复原函数
    untrace(h)
    result
  }

执行修改后的代码，输出结果：

z <- f()
#> Tracing h(g_name = g_name) on entry 
#> The body of `out`
#> g()
#> Call out:
#> [1] 10

方案二：临时修改j的父环境 #

通过临时调整j的父环境为f的环境，让h生成的函数能顺着环境链找到g：

f <- function() {
    g <- function() {
        10
      }
    # 保存j的原父环境
    old_parent_env <- parent.env(environment(j))
    # 将j的父环境临时改为当前f的环境
    parent.env(environment(j)) <- environment()
    result <- j(g_name = "g")
    # 恢复j的原父环境
    parent.env(environment(j)) <- old_parent_env
    result
  }

原理说明 #

• 方案一中，trace函数不会修改h的原代码，仅在其执行末尾临时插入逻辑：把f环境中的g赋值到h生成的out函数的闭包环境，让out()执行时能直接找到g。
• 方案二中，R的函数查找遵循环境链，临时将j的父环境改为f的环境后，h生成的函数在查找g时，会顺着环境链找到f内部定义的g，执行完成后恢复原环境避免影响其他调用。

内容的提问来源于stack exchange，提问作者sfcheung