Function foo1 can subset a list by a requested variable (e.g., by = type == 1). Otherwise, foo1 will simply output the inputted list itself.
For my purposes, I need to use foo1 within a new function called foo2.
In my code below, my desired output is obtained like so: foo2(data = D, by = G[[1]]) ; foo2(data = D, by = G[[2]]) ; foo2(data = D, by = G[[3]]).
But, I wonder why when I loop over G using lapply, I get an error as shown below?
foo1 <- function(data, by){
L <- split(data, data$study.name) ; L[[1]] <- NULL
if(!missing(by)){
L <- lapply(L, function(x) do.call("subset", list(x, by)))
}
return(L)
}
foo2 <- function(data, by){
eval(substitute(foo1(data = data, by = by)))
}
## EXAMPLE OF USE:
D <- read.csv("https://raw.githubusercontent.com/izeh/i/master/k.csv", h = T) ## Data
G <- lapply(unique(na.omit(D$type)), function(i) bquote(type == .(i)))# all levels of `type`
foo2(data = D, by = G[[1]]) # Works fine without `lapply` :-)
lapply(1:3, function(i) foo2(data = D, by = G[[i]])) # Doesn't work with `lapply`! :-(
# Error in do.call("subset", list(x, by)) : object 'i' not found
Your foo2 function tries to evaluate the expression
foo1(data = D, by = G[[i]])
but it doesn't have i available. You need to evaluate G[[i]] in the anonymous function you're passing to lapply to get an expression defining the subset, and then evaluate that subset in foo2. I recommend naming that function instead of using an anonymous one; it makes debugging a lot easier.
Here's some recoding that appears to work:
Redefine foo2 to
foo2 <- function(data, by){
by <- eval(by, envir = data)
foo1(data = data, by = by)
}
and
foo3 <- function(i) {
expr <- G[[i]]
foo2(data = D, by = expr)
}
and then
lapply(1:3, foo3)
I'm not sure this does exactly what you want, but it should be close enough that you can fix it up.
Instead of using lapply, here a for loop can be used
lst1 <- vector("list", length(G))
for(i in 1:3) lst1[[i]] <- foo2(data = D, by = G[[i]])
-checking
identical(lst1[[2]], foo2(data = D, by = G[[2]]))
#[1] TRUE
identical(lst1[[3]], foo2(data = D, by = G[[3]]))
#[1] TRUE
For the lapply part, there seems to be a conflict with i anonymous function which is also called in the G. If we use a new variable say 'j'
lst2 <- lapply(1:3, function(j) foo1(data = D, by = G[[j]]))
should work
identical(lst2[[2]], lst1[[2]])
#[1] TRUE
Related
Background
I'm interested in using do.call to pass arguments to two functions with use of one list. The do.call solution should ignore unused arguments.
Example
my_sum <- function(a, b) {
a + b
}
my_exp <- function(c, d) {
c^d
}
args_to_use <- as.list(1:4)
names(args_to_use) <- letters[1:4]
my_wrapper <- function(fun_args = args_to_use) {
res_one <- do.call(my_sum, fun_args)
res_two <- do.call(my_exp, fun_args)
res_one + res_two
}
Naturally, the example fails as superfluous arguments are passed to both functions.
Desired results
my_wrapper_two <- function(fun_args = args_to_use) {
res_one <- do.call(my_sum, fun_args[1:2]) # Only a, b
res_two <- do.call(my_exp, fun_args[3:4]) # Only c, d
res_one + res_two
}
my_wrapper_two()
# 84
Sought solution
I would like for the subsetting operations [1:2] and [3:4] to be performed automatically depending on the function arguments.
Notes
One approach I was thinking of would be using names(formals(my_exp)) to create desired list of arguments as in:
my_wrapper_three <- function(fun_args = args_to_use) {
res_one <- do.call(my_sum, fun_args[names(formals(my_sum))])
res_two <- do.call(my_exp, fun_args[names(formals(my_exp))])
res_one + res_two
}
my_wrapper_three()
This doesn't look elegant and I'm wondering if there is a more intelligent solution?
Update
The solution I cam up with is as follows:
do_call_on_existing <- function(fun, args_list) {
fun_args <- names(formals(fun))
viable_args <- args_list[fun_args]
viable_args <- Filter(Negate(is.null), viable_args)
do.call(fun, viable_args)
}
The Filter / Negate bit prevents function from failing where my_sum could have extra arguments that would result in arguments list returning null element. So the code can work:
my_sum <- function(a = 999, b = 999, c = 999) {a + b + c}
my_nms <- list(a = 1, b = 2)
do_call_on_existing(my_sum, my_nms)
Try this (... allows you to pass any number of arguments into my_sum but only a and b are used as per your definition):
my_sum <- function(a, b, ...) {
a + b
}
my_exp <- function(c, d, ...) {
c^d
}
args_to_use <- as.list(1:4)
names(args_to_use) <- letters[1:4]
my_wrapper <- function(fun_args = args_to_use) {
res_one <- do.call(my_sum, fun_args)
res_two <- do.call(my_exp, fun_args)
res_one + res_two
}
Similar to the question here. Given a function f with named arguments and a function g taking any number of arguments through ..., how would one
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f()
Error in g(a = a) : argument "a" is missing, with no default
rlang::dots_list sadly did not provide an answer
f2 <- function(a)
h(a = a)
h <- function(...)
rlang::dots_list(..., .ignore_empty = 'all')
f2()
Error in eval(expr, p) : argument "a" is missing, with no default
Edit:
To make the problem more clear, the function g may be called by a myriad of functions, and I'm looking for a way to handle the missing arguments within g and not f.
You can forward ... to subfunctions to multiple depths without evaluating them as long as the subfunctions don't actually perform any evaluation themselves so you don't have to handle this in all functions that receive ... but at the point where it is evaluated you will need to deal with it somehow.
Assuming that f() should return a empty list handle the missing argument separately within g
f <- function(a) g(a = a)
g <- function(..., default = list()) if (missing(..1)) default else list(...)
f()
## [1] list()
or the following which checks each element of ... :
g <- function(..., default = list()) {
L <- list()
for(i in seq_len(...length())) {
x <- try(eval.parent(list(...)[[i]]), silent = TRUE)
L[[i]] <- if (inherits(x, "try-error")) default else x
}
names(L) <- names(substitute(alist(...))[-1])
L
}
f()
## $a
## list()
or within f:
f <- function(a) if (missing(a)) g() else g(a = a)
g <- function(...) list(...)
f()
## [1] list()
Your code seems to be OK except you call f() without a argument at the end... try this:
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f("example")
Or you have to provide a default value for a:
f <- function(a = "example")
g(a = a)
g <- function(...)
list(...)
f()
So the problem is not a missing argument in g(...), but missing argument value in f() when calling g(a = a) without having a.
I'm writing a function f1() that accepts additional parameters "..." to be passed to a function f0() inside of f1(). More precise, f0() is called inside a parallel lapply call, inside of f1. It works fine as long as there is at least one parameter to be passed, but if "..." is empty, I get the error message: " Error in get(name, envir = envir) : argument "..." is missing, with no default"
It works fine if I use lapply, instead of parLapply.
Is there a proper solution? I don't want to define all parameters for f0() explicitly in the definition of f1().
First, I define the function with the two optional parameters.
f0 <- function(a, b, d1 = NULL, d2 = NULL){
if(is.null(d1)){
ret <- a * b
}else{
ret <- a * b / d1
}
if(!is.null(d2)){
ret <- ret - d2
}
ret
}
Next,the functions f1() and f1_par() that do the same, one with sapply and the other with parSapply.
f1 <- function(A, ...){
# A ... vector of a
B <- rev(A)
sapply(seq_along(A), function(i){
f0(A[i], B[i], ...)
})
}
f1_par <- function(A, ...){
# A ... vector of a
B <- rev(A)
cl <- parallel::makeCluster(2)
parallel::clusterExport(cl, envir = environment(), c("A", "B", "f0","..."))
ret <- parallel::parSapply(cl, seq_along(A), function(i){
f0(A[i], B[i], ...)
})
parallel::stopCluster(cl)
ret
}
I get the right results for all of the following six functions calls, except for the last one:
A <- 1:4
# sapply
f1(A, d1 = 2, d2 = 4)
f1(A, d1 = 2)
f1(A)
# parSapply
f1_par(A, d1 = 2, d2 = 4)
f1_par(A, d1 = 2)
f1_par(A) # this one causes the error
I'm pretty sure you cannot export ... that way. Instead, make sure to pass down ... as arguments as in:
f1 <- function(A, ...) {
# A ... vector of a
B <- rev(A)
sapply(seq_along(A), function(i, ...) {
f0(A[i], B[i], ...)
}, ...)
}
Then, do the same with parallel::parSapply().
When requested, function foo1 can subset a list by a desired variable (e.g., by = ESL == 1). Otherwise, foo1 will simply output the inputted list itself.
For my purposes, I need to use foo1 within a new function called foo2. BUT I'm wondering why foo2 fails and how to fix it:
Error in eval(e, x, parent.frame()) : object 'ESL' not found
The full reproducible data and code is below:
foo1 <- function(by, data){
L <- split(data, data$study.name) ; L[[1]] <- NULL
if(!missing(by)){
s <- substitute(by)
H <- lapply(L, function(x) do.call("subset", list(x, s)))
L <- Filter(nrow, H)
}
return(L)
}
## EXAMPLE OF USE:
D <- read.csv("https://raw.githubusercontent.com/izeh/i/master/k.csv", h = T) ## Data
foo1(data = D, by = ESL == 1) ## works fine :-) ####
## BUT:
foo2 <- function(by, data){
foo1(by = by, data = data)
}
## EXAMPLE OF USE:
foo2(data = D, by = ESL == 1) ## Fails :-( ####
Here, we can modify the foo2 to evalluate the function call
foo2 <- function(by, data){
eval(substitute(foo1(by = by, data = data)))
}
out1 <- foo1(data = D, by = ESL == 1)
out2 <- foo2(data = D, by = ESL == 1)
identical(out1, out2)
#[1] TRUE
I am trying to create new functions from a list of function and a list of parameters to be passed to these functions, but am unable to do so so far. Please see the example below.
fun_list <- list(f = function(x, params) {x+params[1]},
z = function(a, params) {a * params[1] * params[2]})
params_list <- list(f = 1, z = c(3, 5))
# goal is to create 2 new functions in global environment
# fnew <- function(x) {x+1}
# znew <- function(a) {a*3*5}
# I've tried
for(x in names(fun_list)){
force(x)
assign(paste0(x, "new"), function(...) fun_list[[x]] (..., params = params_list[[x]]))
}
The goal is to do this dynamically for arbitrary functions and parameters.
Well, force() doesn't work in a for-loop because for loops do not create new environments. Based on a previous question of mine, I created a capture() function
capture <- function(...) {
vars <- sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
this allows
for(x in names(fun_list)) {
f = local({
capture(x);
p = params_list[[x]];
f = fun_list[[x]];
function(x) f(x, p)
})
assign(paste0(x, "new"), f)
}
where we create a local, private environment for the functions to store their default parameter values.
Which gives
fnew(2)
# [1] 3
znew(2)
# [1] 30
How about this:
for(x in names(fun_list)) {
formals(fun_list[[x]])$params <- params_list[[x]]
assign(paste0(x, "new"), fun_list[[x]])
}
This is similar in spirit:
ps <- list(fp=1,zp=c(3,5))
f0s <- substitute(list(f=function(x)x+fp,z=function(a)a*zp1*zp2),as.list(unlist(ps)))
f0s # list(f = function(x) x + 1, z = function(a) a * 3 * 5)
fs <- eval(f0s)
fs$f(1) # 2
To do the fancy thing described in the OP, you'd probably have to mess with formals.