Pass a `chr` type argument and update the content of a nested function to return in R?

Question

For a nested function such as

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

How can I customize the content of the returned function fun_child based on the input var? For example,

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

Desirable output:

function(x) {
  x + y
  }

Actual (undesirable) output:

function(x) {
    x + var
  }

Any help would be greatly appreciated!

Edit: As you may have guessed, the question described above is a simplified version of the actual question I had. The comment by Dan Adams prompted me to redefine my question. Then I realized that it would be hard to explain what I was really looking for without providing some context. So here is another reproducible example, still greatly simplified from my actual question, but with extra information.

Say I want to apply a model to a group of datasets using purrr::map(), and to construct the model based on user input:

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")

I also tried a variation of the version above:

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")

Both versions failed to achieve the result I wanted. An error was returned instead. At first I thought it was because the input var = "x1" could not be passed into fun or into the nested function mod. That's when I posted the original question at the beginning of this post.

After seeing Dan Adams' comment, I tried to approach the question differently. Instead of supplying var = "x1", I turned the entire formula into a parameter, like this:

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

Lo & Behold, this worked!

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

This solution is not quite the same as the original one I had envisioned. However, it does seem more straightforward.

BTW, I am really overwhelmed (in a good way) by how quickly people responded to my original question with some brilliant ideas. I must admit that some of them seemed way over my head. Nevertheless, I am going to carefully review them and try my best to select one as the solution to my original question.

user_1855677 · Answer

If you need to pull a value from the object list based on a name given as a character, then the get function suffices.

 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)
#    }
#
#
Y=6
test(4)
#[1] 10
z=10

test <- fun_parent(var = "z")
print(test)
#function(x) {
#        x + get(var)
#   }
#
#
test(4)
#[1] 14

The value of z is not stored in the test function, only the name is.

 z = 20
 test(4)
[1] 24

But is you want to see how that happens you need to look at the environment itself since the body was not evaluated:

> test
function(x) {
        x + get(var)
    }


> environment(test)$var
[1] "z"

I was a bit surprised that substituting "x" for the value of var succeeded, but I wasn't suprised that using an object name that I knew was in my workspace did work:

> 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

user554330 correctly points out that the name of the object to which var points could be changed. If you wnat to lock in the name you would need to evaluate the "gotten" name:

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

user_12685768 · Answer

I asked a related but not identical question here. Here are two options using bquote:

f <- function(varname) {
  removeSource(eval(bquote(function(x) x + .(as.name(varname)))))
}
f("y")

function (x) 
x + y

op <- options(keep.source = FALSE)
g <- function(varname) {
  eval(bquote(function(x) x + .(as.name(varname))))
}
options(op)
g("y")

function (x) 
x + y

Pass a `chr` type argument and update the content of a nested function to return in R?

2 Answers