We're trying to all users to write a function that will execute depending on variables that will be available at runtime (this is a simulation context).
The user "declares" an inner function using the "function declarer". Later, when the outer function is called, the required piece of information (my var) is available. But we just don't know how to give it to the declared variable.
If possible, we'd like to solve this using rlang / tidyverse style tools. Thanks in advance.
library(rlang)
function_declarer <- function(expr) {
function() {
eval(expr)
}
}
inner_function <- function_declarer(mean(my_var))
outer_function <- function(step) {
my_var <- c(5, 6, 7)
# environment(step) <- env_clone(environment(step), parent = current_env()) # know this does not work
step()
}
outer_function(inner_function)
It seems you just can grab the unevaluated expression and then evaluate it later with eval and the local environment.
library(rlang)
function_declarer <- function(expr) {
enexpr(expr)
}
inner_function <- function_declarer(mean(my_var))
outer_function <- function(step) {
my_var <- c(5, 6, 7)
eval(step)
}
outer_function(inner_function)
So in this scenario we're working with expressions rather than functions. Functions would add a complication because variables are lexically scoped so free variables are looked for in the environment where the function is defined, not where it is called. Using expressions avoids this problem. So you could simplify this with just
inner_function <- quote(mean(my_var)) # base
inner_function <- rlang::expr(mean(my_var)) # rlang
Related
I use the function caRamel from the package with the same name. The function takes another function my_func as an argument....
caRamel(
fn=my_func,
other_caRamel_parameters...
)
my_func is a function taking a unique parameter i (by design, mandatory and given by the caRamel function):
my_func <- function(i) {
require(somelib)
my_path = "C:/myfolder/"
do things with i
...
}
By design, there is no way to pass further arguments to the my_func function inside the caRamel function and I have to hard code everything like the my_path variable for example inside my_func.
However, I would like to be able to pass my_path and others variables as parameters in the caRamel function like so:
caRamel(
fn=my_func,
other_caRamel_parameters...,
my_path="C:/myfolder/", ...
)
with:
my_func <- function(i, my_path) {
require(somelib)
my_path = my_path
do things with i
...
}
I was then wondering if it was possible to write a "wrapper" in this case so that further parameters can be passed to my_func? What could be the options to achieve that?
We can use {purrr} and {rlang} in a custom myCaRamel function which only takes the ellipsis ... as argument.
First we capture the dots with rlang::list2(...).
Then we get all formals of the caRamel function as names with rlang::fn_fmls_names.
Now we differentiate between arguments which go into the caRamel function and those which go into your custom function.
We use purrr::partial to supply the argument which go into your my_fun.
Then we call the original caRamel function using the partial function we created together with the arguments that go in to caRamel.
In the example below I rlang::expr in the last call to show that it is working. Please delete the expr() around the last call to make it actually work.
The downside is that every argument needs to be correctly named. Unnamed arguments and partial matching won't work. Further, if my_fun and caRamel contain arguments with similar names they only go into caRamel and won't reach my_fun.
library(purrr)
library(rlang)
library(caRamel)
my_fun <- function(x, my_path) {
# use my_path
# and some x
}
myCaRamel <- function(...) {
dots <- rlang::list2(...)
caramel_args <- rlang::fn_fmls_names(caRamel)
caramel_args_wo_fun <- caramel_args["func" != caramel_args]
other_args <- names(dots)[!names(dots) %in% caramel_args]
my_fn <- dots[["func"]]
my_fn <- purrr::partial(my_fn, !!! dots[other_args])
rlang::expr( # just to show correct out put - delete this line
caRamel(func = my_fn,
!!! dots[names(dots) %in% caramel_args_wo_fun])
) # delete this line
}
myCaRamel(func = my_fun,
my_path = "C:/myfolder/",
nvar = 10)
#> caRamel(func = my_fn, nvar = 10)
Created on 2021-12-11 by the reprex package (v2.0.1)
I've written an import function that gets a single file from an aws s3-bucket.
That function itself is a wrapper around aws.s3::s3read_using() which takes a reading function as its first argument.
Why do I wrap around aws.s3::s3read_using() ? Because I need to do some special error-handling and want the wrapping function to do some Recall() up to a limit... but that's a different story.
Now that i've successfully build and tested my wrapping function i want to do another wrapping arround that:
I want to iterate n times over my wrapper to bind the downloaded files together. I now have the difficulty to hand the 'reading_function' to the FUN argument of aws.s3::s3read_using().
I could do that by simply using ... - BUT!
I want to make clear to the USER of my wrapping wrapper, that he needs to specify that argument.
So I've decided to use rlangs rlang::enexpr() to capture the argument and to hand it over to my first wrapper via !! - which in return captures that argument again with rlang::enexpr() and hands it over - finally - to aws.s3::s3read_using() via rlang::expr(aws.s3::s3read_using(FUN = !!reading_fn, object = s3_object))
That works perfectly fine and smooth. My Problem is with testing that function construct using testthat and mockery
Here is some broadly simplyfied code:
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
# Some other magic happens here - error handling, condition-checking, etc...
out <- eval(rlang::expr((!!fn)(value_to_work_on)))
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
fn <- rlang::enexpr(fn_to_iter_with)
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(!!fn, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
Now, to the test:
# Throws an ERROR: 'Error in `!fn`: invalid argument type'
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I've used a workarround, but that just doesn't feel right, even though, it works:
# Test passed
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function",
function(fn_to_work_with, value_to_work_on) {
fn <- rlang::enexpr(fn_to_work_with)
out <- mock_1(fn, value_to_work_on)
out})
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
I'm using version of R: 4.1.1
I'm using versions of testthat(3.1.1), mockery(0.4.2), rlang(0.4.12)
I think you're complicating things here, although maybe I'm not fully understanding your end goal. You can directly pass functions through arguments without any issue. Your example code above can be easily simplified to (keeping the loop just to match your test_that() call):
library(testthat)
library(mockery)
my_workhorse_function <- function(fn_to_work_with, value_to_work_on) {
fn_to_work_with(value_to_work_on)
}
my_iterating_function <- function(fn_to_iter_with, iterate_over) {
out <- list()
for(i in seq_along(iterate_over)) {
out[[i]] <- my_workhorse_function(fn_to_iter_with, iterate_over[i])
}
return(out)
}
# Works just fine
my_iterating_function(sqrt, c(9:16))
#> [[1]]
#> [1] 3
#>
#> ...
test_that("my_iterating_function iterates length(iterate_over) times over my_workhorse_function", {
mock_1 <- mockery::mock(1, cycle = TRUE)
stub(my_iterating_function, "my_workhorse_function", mock_1)
expect_equal(my_iterating_function(sqrt, c(9:16)), list(1,1,1,1,1,1,1,1))
expect_called(mock_1, 8)
})
#> Test passed 🥇
You can just pass FUN directly through all of your nested functions. The functions you're wrapping with enexpr() were never going to be evaluated in the first place until you explicitly call them. You usually use enexpr when users are supplying expressions, not just functions.
I have some delicate issues with environments that are currently manifesting themselves in my unit tests. My basic structure is this
I have a main function main that has many arguments
wrapper is a wrapper function (one of many) that pertains only to selected arguments of main
helper is an intermediate helper function that is used by all wrapper functions
I use eval and match.call() to move between wrappers and the main function smoothly. My issue now is that my tests work when I run them line by line, but not using test_that().
Here is a MWE that shows the problem. If you step through the lines in the test manually, the test passes. However, evaluating the whole test_that() chunk the test fails because one of the arguments can not be found.
library(testthat)
wrapper <- function(a, b) {
fun_call <- as.list(match.call())
ret <- helper(fun_call)
return(ret)
}
helper <- function(fun_call) {
fun_call[[1]] <- quote(main)
fun_call <- as.call(fun_call)
fun_eval <- eval(as.call(fun_call))
return(fun_eval)
}
main <- function(a, b, c = 1) {
ret <- list(a = a, b = b, c = c)
return(ret)
}
test_that("Test", {
a <- 1
b <- 2
x <- wrapper(a = a, b = b)
y <- list(a = 1, b = 2, c = 1)
expect_equal(x, y)
})
With quite some confidence, I suspect I need to modify the default environment used by eval (i.e. parent.frame()), but I am not sure how to do this.
You want to evaluate your call in your parent environment, not the local function environment. Change your helper to
helper <- function(fun_call) {
fun_call[[1]] <- quote(main)
fun_call <- as.call(fun_call)
fun_eval <- eval.parent(fun_call, n=2)
return(fun_eval)
}
This is assuming that helper is always called within wrapper which is called from somewhere else the parameters are defined.
It's not clear in this case that you really need all this non-standard evaulation. You might also consider a solution like
wrapper <- function(a, b) {
helper(mget(ls()))
}
helper <- function(params) {
do.call("main", params)
}
Here wrapper just bundles all it's parameters values into a list. Then you can just pass a list of parameters to helper and do.call will pass that list as parameters to your main function. This will evaluate the parameters of wrapper when you call it do you don't have to worry about the execution evironment.
I am using a package that has 2 functions which ultimately look like the following:
pkgFun1 <- function(group) {
call <- match.call()
pkgFun2(call)
}
pkgFun2 <- function(call) {
eval(call$group)
}
If I just call pkgFun1(group = 2), it works fine. But I want to call it from a function:
myFun <- function(x) {
pkgFun1(group = x)
}
myFun(x = 2)
## Error in eval(call$group) : object 'x' not found
Is there any way to avoid this error, if I can't modify the package functions, but only myFun?
There are similar questions, such as Issue with match.call or Non-standard evaluation in a user-defined function with lapply or with in R, but my particular issue is that I can't modify the part of code containing the eval call.
It's pkgFun2 that is wrong, so I think you're out of luck without some weird contortions. It needs to pass the appropriate environment to eval(); if you can't modify it, then you can't fix it.
This hack might appear to work, but in real life it doesn't:
pkgFun1 <- function(group) {
call <- match.call()
f <- pkgFun2
environment(f) <- parent.frame()
f(call)
}
With this, you're calling a copy of pkgFun2 modified so its environment is appropriate to evaluate the call. It works in the test case, but will cause you untold grief in the future, because everything that is not local in pkgFun2 will be searched for in the wrong place. For example,
myFun <- function(x) {
eval <- function(...) print("Gotcha!")
pkgFun1(group = x)
}
myFun(x = 2)
# [1] "Gotcha!"
Best is to fix pkgFun2. Here's one fix:
pkgFun1 <- function(group) {
call <- match.call()
pkgFun2(call, parent.frame())
}
pkgFun2 <- function(call, envir) {
eval(call$group, envir = envir)
}
Edited to add: Actually, there is another hack that is not so weird that should work with your original pkgFun1 and pkgFun2. If you force the evaluation of x to happen in myFun so that pkgFun1 never sees the expression x, it should work. For example,
myFun <- function(x) {
do.call("pkgFun1", list(group = x))
}
If you do this, then after myFun(2), the pkgFun1 variable call will be pkgFun1(group = 2) and you won't get the error about x.
I'm having a little trouble understanding why, in R, the two functions below, functionGen1 and functionGen2 behave differently. Both functions attempt to return another function which simply prints the number passed as an argument to the function generator.
In the first instance the generated functions fail as a is no longer present in the global environment, but I don't understand why it needs to be. I would've thought it was passed as an argument, and is replaced with aNumber in the namespace of the generator function, and the printing function.
My question is: Why do the functions in the list list.of.functions1 no longer work when a is not defined in the global environment? (And why does this work for the case of list.of.functions2 and even list.of.functions1b)?
functionGen1 <- function(aNumber) {
printNumber <- function() {
print(aNumber)
}
return(printNumber)
}
functionGen2 <- function(aNumber) {
thisNumber <- aNumber
printNumber <- function() {
print(thisNumber)
}
return(printNumber)
}
list.of.functions1 <- list.of.functions2 <- list()
for (a in 1:2) {
list.of.functions1[[a]] <- functionGen1(a)
list.of.functions2[[a]] <- functionGen2(a)
}
rm(a)
# Throws an error "Error in print(aNumber) : object 'a' not found"
list.of.functions1[[1]]()
# Prints 1
list.of.functions2[[1]]()
# Prints 2
list.of.functions2[[2]]()
# However this produces a list of functions which work
list.of.functions1b <- lapply(c(1:2), functionGen1)
A more minimal example:
functionGen1 <- function(aNumber) {
printNumber <- function() {
print(aNumber)
}
return(printNumber)
}
a <- 1
myfun <- functionGen1(a)
rm(a)
myfun()
#Error in print(aNumber) : object 'a' not found
Your question is not about namespaces (that's a concept related to packages), but about variable scoping and lazy evaluation.
Lazy evaluation means that function arguments are only evaluated when they are needed. Until you call myfun it is not necessary to evaluate aNumber = a. But since a has been removed then, this evaluation fails.
The usual solution is to force evaluation explicitly as you do with your functionGen2 or, e.g.,
functionGen1 <- function(aNumber) {
force(aNumber)
printNumber <- function() {
print(aNumber)
}
return(printNumber)
}
a <- 1
myfun <- functionGen1(a)
rm(a)
myfun()
#[1] 1