Search code examples
rlistfunctionscopelapply

How to keep function call attributes consistent in lapply and Map?


I want to attach the function call as an attribute. 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)

Expected output

> 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.

Edit

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'

Solution

  • 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 attributes, 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