r - 传递 `chr` 类型参数并更新嵌套函数的内容以在 R 中返回？

Question

对于嵌套函数，例如

fun_parent <- function(var) {
  fun_child <- function(x) {
    x + var
  }
  return(fun_child)
}

如何根据输入的var自定义返回函数fun_child的内容？ 例如，

test <- fun_parent(var = "y")
print(test)

理想的输出:

function(x) {
  x + y
  }
<environment: xxxxxx>

实际(不需要的)输出:

function(x) {
    x + var
  }
<environment: 0x7f7f20126b70>

如有任何帮助，我们将不胜感激!

编辑:您可能已经猜到，上述问题是我所遇到的实际问题的简化版本。 Dan Adams 的评论促使我重新定义我的问题。然后我意识到，如果不提供一些上下文，就很难解释我真正在寻找什么。所以这是另一个可重现的例子，仍然大大简化了我的实际问题，但有额外的信息。

假设我想使用 purrr::map() 将模型应用于一组数据集，并根据用户输入构建模型:

set.seed(1234)

df_demo <- data.frame(
  x1 = rnorm(100),
  x2 = rnorm(100),
  x3 = rnorm(100),
  y = rnorm(100),
  sex = factor(rep(c("f", "m"), each = 50))
  )

func <- function(var) {
  mod <- function(data) {
    lm(y ~ var, data = data) # var is supplied by users
  }

  output <- df_demo |>
    dplyr::group_by(group) |>
    tidyr::nest() |>
    dplyr::mutate(
      model = purrr::map(data, mod),
      tidy = purrr::map(model, broom::tidy)
    ) |>
    tidyr::unnest(tidy)

  return(output)
}

test <- func(var = "x1")

我还尝试了上述版本的变体:

df_demo <- ...

func <- function(var) {
  output <- df_demo |>
    dplyr::group_by(group) |>
    tidyr::nest() |>
    dplyr::mutate(model = purrr::map(data,
        function(data, ...) {
          lm(y ~ var, data = data)
        }),
      tidy = purrr::map(model, broom::tidy)
      ) |>
    tidyr::unnest(tidy)

  return(output)
}
test <- func(var = "x1")

两个版本都没有达到我想要的结果。 而是返回了一个错误。 一开始我以为是因为输入的var = "x1"不能传入fun或者传入嵌套函数mod。那是我在本文开头发布原始问题的时候。

在看到 Dan Adams 的评论后，我尝试以不同的方式处理这个问题。我没有提供 var = "x1"，而是将整个 formula 变成了一个参数，如下所示:

# func <- function(var) {
func <- function(formula) {
  output <- df_demo |>
    dplyr::group_by(group) |>
    tidyr::nest() |>
    dplyr::mutate(model = purrr::map(data,
        function(data, ...) {
          # lm(y ~ var, data = data)
          lm(formula, data = data)
        }),
      tidy = purrr::map(model, broom::tidy)
      ) |>
    tidyr::unnest(tidy)
  return(output)
}
# test <- func(var = "x1")
test <- func(formula = y ~ x1)

瞧，这成功了!

> test
# A tibble: 4 × 8
# Groups:   group [2]
  group data              model  term        estimate std.error statistic p.value
  <fct> <list>            <list> <chr>          <dbl>     <dbl>     <dbl>   <dbl>
1 f     <tibble [50 × 6]> <lm>   (Intercept)   0.0675     0.170     0.398 0.692
2 f     <tibble [50 × 6]> <lm>   x1            0.0763     0.160     0.477 0.636
3 m     <tibble [50 × 6]> <lm>   (Intercept)  -0.106      0.124    -0.855 0.397
4 m     <tibble [50 × 6]> <lm>   x1            0.384      0.128     3.01  0.00419

这个解决方案与我最初设想的不太一样。然而，它似乎更直接。

顺便说一句，我真的(以一种好的方式)对人们用一些绝妙的想法回答我最初的问题的速度如此之快感到不知所措。我必须承认，其中一些似乎超出了我的理解范围。尽管如此，我还是会仔细审查它们，并尽力选择一个作为我最初问题的解决方案。

Answer 1

如果您需要根据作为字符给出的名称从对象列表中提取值，那么 get 函数就足够了。

 fun_parent <- function(var) {
     force(var)
     fun_child <- function(x) {
         x + get(var)
     }
     return(fun_child)
 }
 test <- fun_parent(var = "y")
 print(test)

#function(x) {
#        x + get(var)
#    }
#
#<environment: 0x5654f87a1ae8>
Y=6
test(4)
#[1] 10
z=10

test <- fun_parent(var = "z")
print(test)
#function(x) {
#        x + get(var)
#   }
#<bytecode: 0x5654f7eac430>
#<environment: 0x5654f7637bb8>
test(4)
#[1] 14

z 的值不存储在 test 函数中，只有名称。

 z = 20
 test(4)
[1] 24

但是如果你想知道这是怎么发生的，你需要查看环境本身，因为 body 没有被评估:

> test
function(x) {
        x + get(var)
    }
<bytecode: 0x5654f7eac430>
<environment: 0x5654f7637bb8>
> environment(test)$var
[1] "z"

用 "x" 替换 var 的值成功让我有点惊讶，但我并不惊讶使用我知道的对象名称我的工作区确实有效:

> environment(test)$var <- "x"
> test(4)
[1] 8
> x     # only existed in the parameter list but was stored in the environment
Error: object 'x' not found  
> environment(test)$var <- "y"
> test(4)
[1] 10

用户 554330 正确指出 var 指向的对象的名称可以更改。如果您想锁定名称，则需要评估“获得的”名称:

fun_parent <- function(var) {
     fun_child <- function(x) {
         x + force(get(var))
     }
     return(fun_child)
 }
 test <- fun_parent(var = "y")
 print(test)
#function(x) {
#       x + force(get(var))
#    }
#<environment: 0x565514c4ae38>
 test(4)
#[1] 10
 fy <-  fun_parent(var = "y")
 fz <-  fun_parent(var = "z")
 y=10
 z=20
 fy(4)
#[1] 14
 fz(4)
#[1] 24
 ls( environment(fy) )
#[1] "fun_child" "var"      
 environment(fy)$var 
#[1] "y"
  environment(fz)$var 
#[1] "z"