I would like to capture a function's arguments within its body to help with logging. I have found that match.call() and sys.call() work when the argument value is explicitly stated in the function call, but don't output an evaluated value when an object name is used.
Here's a simplified example:
gauss_vector <- function(number) {
sys_args <- as.list(sys.call())
match_args <- as.list(match.call())
output <- rnorm(n = number)
list(sys_args,
match_args,
output)
}
When this function is called like this:
gauss_vector(number = 5)
The resulting list includes the value 5.
[[1]]
[[1]][[1]]
gauss_vector
[[1]]$number
[1] 5
[[2]]
[[2]][[1]]
gauss_vector
[[2]]$number
[1] 5
[[3]]
[1] 0.9663434 0.8051087 0.1576298 0.3189806 -2.3110680
However, when the function is called like this:
n <- 5
gauss_vector(number = n)
The resulting list only includes n.
[[1]]
[[1]][[1]]
gauss_vector
[[1]]$number
n
[[2]]
[[2]][[1]]
gauss_vector
[[2]]$number
n
[[3]]
[1] -0.6017670 -0.7631405 0.7793892 -0.7529637 1.3022802
Is there a way to capture the evaluated figure rather than the object name when the function is called in the second way?
You could eval all the arguments passed to the function.
gauss_vector <- function(number) {
sys_args <- as.list(sys.call())
sys_args[-1] <- lapply(sys_args[-1], eval)
match_args <- as.list(match.call())
match_args[-1] <- lapply(match_args[-1], eval)
output <- rnorm(n = number)
list(sys_args,match_args,output)
}
gauss_vector(n)
#[[1]]
#[[1]][[1]]
#gauss_vector
#[[1]][[2]]
#[1] 5
#[[2]]
#[[2]][[1]]
#gauss_vector
#[[2]]$number
#[1] 5
#[[3]]
#[1] 0.6998265 0.4037748 1.8558809 -0.1343624 -1.5600925
Related
I made almost the same question in another post, but asking just for column name, and received a perfect solution for that need. Now what I need is the variable full name. I reformulate here.
I use 'deparse(substitute(x))' from inside my function to get variable name passed as parameter. It works great... but not with 'lapply'
myfun <- function(x)
{
return(deparse(substitute(x)))
}
a <- c(1,2,3)
b <- c(4,5,5)
df<-data.frame(a,b)
myfun(df$a)
[1] "df$a"
but, with 'lapply'...
lapply(df, myfun)
$a
[1] "X[[i]]"
$b
[1] "X[[i]]"
How can I get the variable name inside 'lapply'?
Thanks
When you pass a data frame to lapply, it iterates through the columns by numerical indexing using the double square bracket, not name indexing using the $ accessor. It is equivalent to using the following loop:
X <- df
result <- list()
for(i in seq_along(X)) {
result[[i]] <- myfun(X[[i]])
}
names(result) <- names(X)
result
#> $a
#> [1] "X[[i]]"
#>
#> $b
#> [1] "X[[i]]"
So a simple deparse(substitute(x)) will not work inside lapply. You are not recovering the column name, but rather would need to reconstruct it from the call stack. This is full of caveats and gotchas, but a (relatively) simple approach would be:
myfun <- function(x) {
stack <- lapply(sys.calls(), function(x) sapply(as.list(x), deparse))
if(stack[[length(stack)]][1] == 'myfun') {
return(stack[[length(stack)]][2])
}
if(stack[[length(stack)]][1] == 'FUN') {
return(paste0(stack[[length(stack) - 1]][2], '$',
eval(quote(names(X)[i]), parent.frame())))
}
deparse(substitute(x))
}
This means your function will still work if called directly:
myfun(df$a)
#> [1] "df$a"
But will also work within lapply
lapply(df, myfun)
#> $a
#> [1] "df$a"
#>
#> $b
#> [1] "df$b"
lapply(iris, myfun)
#> $Sepal.Length
#> [1] "iris$Sepal.Length"
#>
#> $Sepal.Width
#> [1] "iris$Sepal.Width"
#>
#> $Petal.Length
#> [1] "iris$Petal.Length"
#>
#> $Petal.Width
#> [1] "iris$Petal.Width"
#>
#> $Species
#> [1] "iris$Species"
It is specifically written to cover direct use or use within lapply. If you wanted to expand its use to work within other functional calls like Map or the various purrr mapping functions, then these would have to be covered specifically by their own if clauses.
Here is another solution, its a bit verbose and Allen's solution is much better:
myfun <- function(x) {
pf <- parent.frame()
x_nm <- deparse(substitute(x))
frame_n <- sys.nframe()
apply <- FALSE
while(frame_n > 0) {
cl <- as.list(sys.call(frame_n))
if (grepl("apply", cl[[1]])) {
x_obj <- cl[[2]]
apply <- TRUE
break
}
frame_n <- frame_n - 1L
}
if (apply) {
idx <- parent.frame()$i[]
obj <- get(x_obj, envir = pf)
if (!is.null(names(obj)[idx])) {
nm_or_idx <- names(obj)[idx]
} else {
nm_or_idx <- idx
}
x_nm <- paste0(x_obj, '$', nm_or_idx)
}
return(x_nm)
}
myfun(df$a)
#> [1] "df$a"
lapply(df, myfun)
#> $a
#> [1] "df$a"
#>
#> $b
#> [1] "df$b"
Created on 2023-02-09 by the reprex package (v2.0.1)
We can define a character string 'col_name'to take the name of the data frame column in the function. For example, if col_name is "a", df[[col_name]] extracts "a" column from data frame.Then we can use the paste() function to concatenate the string 'df$' and 'col_name':
myfun <- function(col_name) {
col <- df[[col_name]]
return(paste("df$", col_name, sep = ""))
}
lapply(colnames(df), myfun)
output
[[1]]
[1] "df$a"
[[2]]
[1] "df$b"
If we would like to assign any data we could do the assignment and then run lapply for example:
df <- iris
lapply(colnames(df), myfun)
output
[[1]]
[1] "df$Sepal.Length"
[[2]]
[1] "df$Sepal.Width"
[[3]]
[1] "df$Petal.Length"
[[4]]
[1] "df$Petal.Width"
[[5]]
[1] "df$Species"
I hope this could helps.
I need to forward ... to a function argument, extract the symbols as code, and convert them to characters, all while preserving names. I usually use match.call(expand.dots = FALSE)$... for this, but it mangles the !! operator.
Current behavior
f <- function(...){
match.call(expand.dots = FALSE)$...
}
f(a = 1234, b = !!my_variable)
## $a
## [1] 1234
##
## $b
## !(!my_variable)
Desired behavior
f <- function(...){
# whatever works
}
f(a = 1234, b = !!my_variable)
## $a
## [1] 1234
##
## $b
## !!my_variable
EDIT Even better:
f <- function(...){
# whatever works
}
my_variable <- "my value"
f(a = 1234, b = !!my_variable)
## $a
## [1] 1234
##
## $b
## [1] "my_value"
The following code appears to work. The use case is here. Thanks to MrFlick for nudging me in the right direction.
f <- function(...){
rlang::exprs(...)
}
my_variable <- "my value"
f(a = 1234, b = !!my_variable)
## $a
## [1] 1234
##
## $b
## [1] "my_value"
EDIT: by the way, I am still looking for a way to parse !! without evaluating it. This would enhance user-side functionality related to https://github.com/ropensci/drake/issues/200.
In the following code below I want to get the number for pattern[i] instead of pattern itself in get_number. Thanks
pattern <- c("Ago2_1","Ago2_2", "WT_1", "WT_2", "DCLd_1", "DCLd_2")
##STATS
Ago2_1 <- 299117512
Ago2_2 <- 29564885
DCLd_1 <- 67004254
DCLd_2 <- 77682528
WT_1 <- 27073135
WT_2 <- 113214012
for ( i in 1:length(pattern)){
get_number <- pattern [i]
}
You can use get(). In your for loop, i is one of the strings in pattern. Therefore, just use get() to retrieve its numeric value and store it somewhere (in this example, in a list).
pattern <- c("Ago2_1","Ago2_2", "WT_1", "WT_2", "DCLd_1", "DCLd_2")
##STATS
Ago2_1 <- 29911751
Ago2_2 <- 29564885
DCLd_1 <- 67004254
DCLd_2 <- 77682528
WT_1 <- 27073135
WT_2 <- 113214012
# initialize a collector
get_number <- list()
for ( i in pattern){
get_number[[(length(get_number) + 1)]] <- get(i)
}
get_number
[[1]]
[1] 29911751
[[2]]
[1] 29564885
[[3]]
[1] 27073135
[[4]]
[1] 113214012
[[5]]
[1] 67004254
We can use mget to return the values in a list
mget(pattern)
#$Ago2_1
#[1] 29911751
#$Ago2_2
#[1] 29564885
#$WT_1
#[1] 27073135
#$WT_2
#[1] 113214012
#$DCLd_1
#[1] 67004254
#$DCLd_2
#[1] 77682528
Let's say I have a list of data.frames
dflist <- list(data.frame(a=1:3), data.frame(b=10:12, a=4:6))
If i want to extract the first column from each item in the list, I can do
lapply(dflist, `[[`, 1)
# [[1]]
# [1] 1 2 3
#
# [[2]]
# [1] 10 11 12
Why can't I use the "$" function in the same way
lapply(dflist, `$`, "a")
# [[1]]
# NULL
#
# [[2]]
# NULL
But these both work:
lapply(dflist, function(x) x$a)
`$`(dflist[[1]], "a")
I realize that in this case one could use
lapply(dflist, `[[`, "a")
but I was working with an S4 object that didn't seem to allow indexing via [[. For example
library(adegenet)
data(nancycats)
catpop <- genind2genpop(nancycats)
mylist <- list(catpop, catpop)
#works
catpop[[1]]$tab
#doesn't work
lapply(mylist, "$", "tab")
# Error in slot(x, name) :
# no slot of name "..." for this object of class "genpop"
#doesn't work
lapply(mylist, "[[", "tab")
# Error in FUN(X[[1L]], ...) : this S4 class is not subsettable
For the first example, you can just do:
lapply(dflist, `$.data.frame`, "a")
For the second, use the slot() accessor function
lapply(mylist, "slot", "tab")
I'm not sure why method dispatch doesn't work in the first case, but the Note section of ?lapply does address this very issue of its borked method dispatch for primitive functions like $:
Note:
[...]
For historical reasons, the calls created by ‘lapply’ are
unevaluated, and code has been written (e.g., ‘bquote’) that
relies on this. This means that the recorded call is always of
the form ‘FUN(X[[i]], ...)’, with ‘i’ replaced by the current
(integer or double) index. This is not normally a problem, but it
can be if ‘FUN’ uses ‘sys.call’ or ‘match.call’ or if it is a
primitive function that makes use of the call. This means that it
is often safer to call primitive functions with a wrapper, so that
e.g. ‘lapply(ll, function(x) is.numeric(x))’ is required to ensure
that method dispatch for ‘is.numeric’ occurs correctly.
So it seems that this problem has more to do with $ and how it typically expects unquoted names as the second parameter rather than strings. Look at this example
dflist <- list(
data.frame(a=1:3, z=31:33),
data.frame(b=10:12, a=4:6, z=31:33)
)
lapply(dflist,
function(x, z) {
print(paste("z:",z));
`$`(x,z)
},
z="a"
)
We see the results
[1] "z: a"
[1] "z: a"
[[1]]
[1] 31 32 33
[[2]]
[1] 31 32 33
so the z value is being set to "a", but $ isn't evaluating the second parameter. So it's returning the "z" column rather than the "a" column. This leads to this interesting set of results
a<-"z"; `$`(dflist[[1]], a)
# [1] 1 2 3
a<-"z"; `$`(dflist[[1]], "z")
# [1] 31 32 33
a<-"z"; `$.data.frame`(dflist[[1]], a)
# [1] 31 32 33
a<-"z"; `$.data.frame`(dflist[[1]], "z")
# [1] 31 32 33
When we call $.data.frame directly we are bypassing the standard deparsing that occurs in the primitive prior to dispatching (which happens near here in the source).
The added catch with lapply is that it passes along arguments to the function via the ... mechanism. For example
lapply(dflist, function(x, z) sys.call())
# [[1]]
# FUN(X[[2L]], ...)
# [[2]]
# FUN(X[[2L]], ...)
This means that when $ is invoked, it deparses the ... to the string "...". This explains this behavior
dflist<- list(data.frame(a=1:3, "..."=11:13, check.names=F))
lapply(dflist, `$`, "a")
# [[1]]
# [1] 11 12 13
Same thing happens when you try to use ... yourself
f<-function(x,...) `$`(x, ...);
f(dflist[[1]], "a");
# [1] 11 12 13
`$`(dflist[[1]], "a")
# [1] 1 2 3
I am having trouble figuring out how to use do.call to call and run a list of functions.
for example:
make.draw = function(i){i;function()runif(i)}
function.list = list()
for (i in 1:3) function.list[[i]] = make.draw(i)
will result in
> function.list[[1]]()
[1] 0.2996515
> function.list[[2]]()
[1] 0.7276203 0.4704813
> function.list[[3]]()
[1] 0.9092999 0.7307774 0.4647443
what I want to do is create a function that calls all three functions in the list at one go. from what I understand as.call() can be used to do this but I am having trouble connecting the dots and getting 6 uniform random draws from function.list.
Did you want something like this?
lapply(function.list, do.call, list())
# [[1]]
# [1] 0.5777857
# [[2]]
# [1] 0.8970102 0.5892031
# [[3]]
# [1] 0.4712016 0.2624851 0.2353192
make.draw = function(i){runif(i)}
Map(make.draw, 1:3)
#[[1]]
#[1] 0.03442084
#[[2]]
#[1] 0.6899443 0.8896434
#[[3]]
#[1] 0.3899678 0.2845898 0.4920698