I want to attach the function call as an attr
ibute. While using fn()
directly works fine, when I run it inside lapply()
, it returns X[[i]]
instead of the actual name passed to the d=
parameter. I expect to see df1
and df2
as the output, not X[[i]]
.
> fn <- \(d, x=x, y=999, ...) {
+ cl <- match.call()
+ fa <- formals(fn)
+ fa[length(fa)] <- NULL
+ ma <- setdiff(names(fa), names(cl))
+ cl[ma] <- fa[ma]
+ cl[-c(1, 2)] <- lapply(cl[-c(1, 2)], eval, envir=parent.frame())
+ # cl$d <- quote(d)
+ res <- d[[1]] ## so `res` depends on `d`
+ attr(res, 'call') <- cl
+ return(res)
+ }
>
> z. <- 777
> df1 <- lst$df1
> df2 <- lst$df2
> fn(df1, x=666, z=z.)
[1] 1 2 3
attr(,"call")
fn(d = df1, x = 666, z = 777, y = 999)
> lapply(list(df1=df1, df2=df2), fn, x=666, z=z.)
$df1
[1] 1 2 3
attr(,"call")
FUN(d = X[[i]], x = 666, z = 777, y = 999)
$df2
[1] 1 2 3
attr(,"call")
FUN(d = X[[i]], x = 666, z = 777, y = 999)
This obviously relates to an earlier question, so I tried Map
as proposed, however, apparently it doesn't generalize well.
> Map(list(df1=df1, df2=df2), f=fn, x=666, z=z.)
$df1
[1] 1 2 3
attr(,"call")
(\(d, x=x, y=999, ...) {
cl <- match.call()
fa <- formals(fn)
fa[length(fa)] <- NULL
ma <- setdiff(names(fa), names(cl))
cl[ma] <- fa[ma]
cl[-c(1, 2)] <- lapply(cl[-c(1, 2)], eval, envir=parent.frame())
# cl$d <- quote(d)
res <- d[[1]]
attr(res, 'call') <- cl
return(res)
})(d = dots[[1L]][[2L]], x = 666, z = 777, y = 999)
$df2
[1] 1 2 3
attr(,"call")
(\(d, x=x, y=999, ...) {
cl <- match.call()
fa <- formals(fn)
fa[length(fa)] <- NULL
ma <- setdiff(names(fa), names(cl))
cl[ma] <- fa[ma]
cl[-c(1, 2)] <- lapply(cl[-c(1, 2)], eval, envir=parent.frame())
# cl$d <- quote(d)
res <- d[[1]]
attr(res, 'call') <- cl
return(res)
})(d = dots[[1L]][[2L]], x = 666, z = 777, y = 999)
Then I tried to do cl$d <- quote(d)
, cl$d <- quote(substitute(d))
, cl$d <- quote(eval(parse(text=d)))
, cl$d <- quote(get(d))
, as commented out above, to no avail. Here result of cl$d <- quote(d)
version:
> fn(df1, x=666, z=z.)
[1] 1 2 3
attr(,"call")
fn(d = d, x = 666, z = 777, y = 999)
> lapply(list(df1=df1, df2=df2), fn, x=666, z=z.)
$df1
[1] 1 2 3
attr(,"call")
FUN(d = d, x = 666, z = 777, y = 999)
$df2
[1] 1 2 3
attr(,"call")
FUN(d = d, x = 666, z = 777, y = 999)
> lapply(list(df1=df1, df2=df2), fn, x=666, z=z.)
$df1
[1] TRUE
attr(,"call")
FUN(d = df1, x = 666, z = 777, y = 999)
$df2
[1] TRUE
attr(,"call")
FUN(d = df2, x = 666, z = 777, y = 999)
Just a heads up, I'm looking for a solution using base R.
After @MrFlick's answer, I see I need to clarify. Actually I have a large list lst
:
> lst <- list(df1=df1, df2=df2)
> lapply(lst, function(x)
+ do.call("fn", list(as.name(x), x=666, z=z.))
+ )
Error in as.vector(x, mode = mode) :
'list' object cannot be coerced to type 'symbol'
I came up with this solution that uses elements of @MrFlick's answer, to use do.call()
, and from the answer to pass the names in Map()
quoted in the OP.
We just need to insert one if
clause in fn()
. In the call fn()
we replace d
-- if
present in the ellipsis -- with certain parameters and attr
ibutes, or leave it as it is.
> fn <- function(d, x=666, y=999, z, ...) {
+ cl <- match.call()
+ fa <- formals(fn)
+ fa[length(fa)] <- NULL
+ ma <- setdiff(names(fa), names(cl))
+ cl[ma] <- fa[ma]
+ cl[-c(1, 2)] <- lapply(cl[-c(1, 2)], eval, envir=parent.frame())
+ if (".name" %in% names(list(...))) {
+ .name <- sprintf('%s$%s', attr(d, 'lnm'), list(...)$.name)
+ cl$d <- str2lang(.name)
+ cl$.name <- NULL
+ }
+ res <- d[[1]]
+ attr(res, 'call') <- cl
+ return(res)
+ }
In the lapply
call, we pass the names
in a .name
parameter that triggers the if
clause in fn()
as well as the list name using deparse(substitute(.))
.
> lapply(names(lst), \(x) {
+ do.call("fn",
+ list(
+ d=`attr<-`(
+ get(x, envir=as.environment(lst)), 'lnm', deparse(substitute(lst))
+ ),
+ x=666, y=999, z=z., .name=x)
+ )})
$df1
[1] 1 2 3
attr(,"call")
fn(d = lst$df1, x = 666, y = 999, z = 777)
$df2
[1] 1 2 3
attr(,"call")
fn(d = lst$df2, x = 666, y = 999, z = 777)
This also works for single runs as intended. Both options allow the call to be copied and executed.
> fn(d=df3, x=666, z=z.)
[1] 1 2 3
attr(,"call")
fn(d = df3, x = 666, z = 777, y = 999)
>
> fn(d=lst$df1, x=666, z=z.)
[1] 1 2 3
attr(,"call")
fn(d = lst$df1, x = 666, z = 777, y = 999)
Limitations
The Map
call is not trivial. Also, fn()
must be changed, which is not a problem for my use case, since fn()
belongs to me, but can lead to problems if it came from a package. Issues may occur if it is used in several nested calls, which has not been tested.
Data:
> lst <- replicate(2, data.frame(matrix(1:12, 3, 4)), simplify=FALSE) |>
+ setNames(c('df1', 'df2'))
> z. <- 777
> df3 <- lst$df1