I would like use a function that uses the standard deparse(substitute(x)) trick within lapply. Unfortunately I just get the argument of the loop back. Here's my completely useless reproducible example:
# some test data
a <- 5
b <- 6
li <- list(a1=a,b2=b)
# my test function
tf <- function(obj){
nm <- deparse(substitute(obj))
res <- list(myName=nm)
res
}
tf(a)
#returns
$myName
[1] "a"
which is fine. If I use lapply I either get [[1L]] or the x argument of an anonymous function.
lapply(li,function(x) tf(x))
# returns
$a1
$a1$myName
[1] "x"
$b2
$b2$myName
[1] "x"
Is there any way to obtain the following?
$a1
$a1$myName
[1] "a1"
$b2
$b2$myName
[1] "b1"
If there's anything more general on deparse(substitute(x)) and lapply I'd also eager to know.
EDIT:
The problem as opposed to using an anonymous function that accepts multiple arguments and can thus use the name of the object and the object itself does not work because, the tf function will only accept one argument. So this does not work here...
A possible solution :
lapply(li, function(x) {
call1 <- sys.call(1)
call1[[1]] <- as.name("names")
call1 <- call1[1:2]
nm <- eval(call1)
y <- deparse(substitute(x))
y <- gsub("\\D", "", y)
y <- as.numeric(y)
list(myname=nm[y])
})
Related
For example, suppose I would like to be able to define a function that returned the name of the assignment variable concatenated with the first argument:
a <- add_str("b")
a
# "ab"
The function in the example above would look something like this:
add_str <- function(x) {
arg0 <- as.list(match.call())[[1]]
return(paste0(arg0, x))
}
but where the arg0 line of the function is replaced by a line that will get the name of the variable being assigned ("a") rather than the name of the function.
I've tried messing around with match.call and sys.call, but I can't get it to work. The idea here is that the assignment operator is being called on the variable and the function result, so that should be the parent call of the function call.
I think that it's not strictly possible, as other solutions explained, and the reasonable alternative is probably Yosi's answer.
However we can have fun with some ideas, starting simple and getting crazier gradually.
1 - define an infix operator that looks similar
`%<-add_str%` <- function(e1, e2) {
e2_ <- e2
e1_ <- as.character(substitute(e1))
eval.parent(substitute(e1 <- paste0(e1_,e2_)))
}
a %<-add_str% "b"
a
# "ab"
2 - Redefine := so that it makes available the name of the lhs to the rhs through a ..lhs() function
I think it's my favourite option :
`:=` <- function(lhs,rhs){
lhs_name <- as.character(substitute(lhs))
assign(lhs_name,eval(substitute(rhs)), envir = parent.frame())
lhs
}
..lhs <- function(){
eval.parent(quote(lhs_name),2)
}
add_str <- function(x){
res <- paste0(..lhs(),x)
res
}
a := add_str("b")
a
# [1] "ab"
There might be a way to redefine <- based on this, but I couldn't figure it out due to recursion issues.
3 - Use memory address dark magic to hunt lhs (if it exists)
This comes straight from: Get name of x when defining `(<-` operator
We'll need to change a bit the syntax and define the function fetch_name for this purpose, which is able to get the name of the rhs from a *<- function, where as.character(substitute(lhs)) would return "*tmp*".
fetch_name <- function(x,env = parent.frame(2)) {
all_addresses <- sapply(ls(env), pryr:::address2, env)
all_addresses <- all_addresses[names(all_addresses) != "*tmp*"]
all_addresses_short <- gsub("(^|<)[0x]*(.*?)(>|$)","\\2",all_addresses)
x_address <- tracemem(x)
untracemem(x)
x_address_short <- tolower(gsub("(^|<)[0x]*(.*?)(>|$)","\\2",x_address))
ind <- match(x_address_short, all_addresses_short)
x_name <- names(all_addresses)[ind]
x_name
}
`add_str<-` <- function(x,value){
x_name <- fetch_name(x)
paste0(x_name,value)
}
a <- NA
add_str(a) <- "b"
a
4- a variant of the latter, using .Last.value :
add_str <- function(value){
x_name <- fetch_name(.Last.value)
assign(x_name,paste0(x_name,value),envir = parent.frame())
paste0(x_name,value)
}
a <- NA;add_str("b")
a
# [1] "ab"
Operations don't need to be on the same line, but they need to follow each other.
5 - Again a variant, using a print method hack
Extremely dirty and convoluted, to please the tortured spirits and troll the others.
This is the only one that really gives the expected output, but it works only in interactive mode.
The trick is that instead of doing all the work in the first operation I also use the second (printing). So in the first step I return an object whose value is "b", but I also assigned a class "weird" to it and a printing method, the printing method then modifies the object's value, resets its class, and destroys itself.
add_str <- function(x){
class(x) <- "weird"
assign("print.weird", function(x) {
env <- parent.frame(2)
x_name <- fetch_name(x, env)
assign(x_name,paste0(x_name,unclass(x)),envir = env)
rm(print.weird,envir = env)
print(paste0(x_name,x))
},envir = parent.frame())
x
}
a <- add_str("b")
a
# [1] "ab"
(a <- add_str("b") will have the same effect as both lines above. print(a <- add_str("b")) would also have the same effect but would work in non interactive code, as well.
This is generally not possible because the operator <- is actually parsed to a call of the <- function:
rapply(as.list(quote(a <- add_str("b"))),
function(x) if (!is.symbol(x)) as.list(x) else x,
how = "list")
#[[1]]
#`<-`
#
#[[2]]
#a
#
#[[3]]
#[[3]][[1]]
#add_str
#
#[[3]][[2]]
#[1] "b"
Now, you can access earlier calls on the call stack by passing negative numbers to sys.call, e.g.,
foo <- function() {
inner <- sys.call()
outer <- sys.call(-1)
list(inner, outer)
}
print(foo())
#[[1]]
#foo()
#[[2]]
#print(foo())
However, help("sys.call") says this (emphasis mine):
Strictly, sys.parent and parent.frame refer to the context of the
parent interpreted function. So internal functions (which may or may
not set contexts and so may or may not appear on the call stack) may
not be counted, and S3 methods can also do surprising things.
<- is such an "internal function":
`<-`
#.Primitive("<-")
`<-`(x, foo())
x
#[[1]]
#foo()
#
#[[2]]
#NULL
As Roland pointed, the <- is outside of the scope of your function and could only be located looking at the stack of function calls, but this fail. So a possible solution could be to redefine the '<-' else than as a primitive or, better, to define something that does the same job and additional things too.
I don't know if the ideas behind following code can fit your needs, but you can define a "verbose assignation" :
`:=` <- function (var, value)
{
call = as.list(match.call())
message(sprintf("Assigning %s to %s.\n",deparse(call$value),deparse(call$var)))
eval(substitute(var <<- value))
return(invisible(value))
}
x := 1:10
# Assigning 1:10 to x.
x
# [1] 1 2 3 4 5 6 7 8 9 10
And it works in some other situation where the '<-' is not really an assignation :
y <- data.frame(c=1:3)
colnames(y) := "b"
# Assigning "b" to colnames(y).
y
# b
#1 1
#2 2
#3 3
z <- 1:4
dim(z) := c(2,2)
#Assigning c(2, 2) to dim(z).
z
# [,1] [,2]
#[1,] 1 3
#[2,] 2 4
>
I don't think the function has access to the variable it is being assigned to. It is outside of the function scope and you do not pass any pointer to it or specify it in any way. If you were to specify it as a parameter, you could do something like this:
add_str <- function(x, y) {
arg0 <-deparse(substitute(x))
return(paste0(arg0, y))
}
a <- 5
add_str(a, 'b')
#"ab"
In R, I need the name of a function that was passed as argument to nested functions.
> fun1 <- function(f) deparse(substitute(f))
> fun2 <- function(f) fun1(f)
> fun1(mean)
[1] "mean"
> fun2(mean)
[1] "f"
>
How can I obtain the name of a function independent of the number of times it has been passed as an argument to nested functions?
This does the substitution in the first frame on the stack:
fun1 <- function(f) deparse(substitute(f, sys.frame(1)))
fun2 <- function(f) fun1(f)
fun1(mean)
#[1] "mean"
fun2(mean)
#[1] "mean"
Obviously, this will fail if you don't pass the argument through from the most outer function:
fun3 <- function() fun2(mean)
fun3()
#[1] "f"
If will also fail, if you change the parameter name:
fun2 <- function(g) fun1(g)
fun2(mean)
#[1] "f"
However, it might be sufficient for your use case (which you haven't described).
If those constraints are a problem, we need something more sophisticated and inefficient:
fun1 <- function(f) {
fr <- rev(sys.frames())
f <- substitute(f, fr[[1]])
#loop over the frame stack
for (i in seq_along(fr)[-1]) {
f <- eval(bquote(substitute(.(f), fr[[i]])))
}
deparse(f)
}
fun2 <- function(g) fun1(g)
fun3 <- function() fun2(mean)
fun1(mean)
#[1] "mean"
fun2(mean)
#[1] "mean"
fun3()
#[1] "mean"
Of course, this would still break in edge cases:
fun4 <- function(mean) fun3()
fun4(2)
#[1] "2"
You could try handling them, but I'll stop here.
I have the following code:
fn <- 'George'
mn <- 'Walker'
ln <- 'Bush'
f <- function(...) { print(list(...)) }
When I call it, it produces the following output:
f(fn,mn,ln)
[[1]]
[1] "George"
[[2]]
[1] "Walker"
[[3]]
[1] "Bush"
Suppose I wanted something similar to this (note the parameter names):
fn:George
mn:Walker
ln:Bush
Question: I know how to get the VALUES of the arguments inside a function. How do I get the NAMES of the arguments inside the function?
Thanks, CC.
You may use
f <- function(...) {
nm1 <- as.list(match.call()[-1])
val <- list(...)
cat(paste(nm1, val, sep=":", collapse="\n"),'\n') }
f(fn,mn,ln)
#fn:George
#mn:Walker
#ln:Bush
So consider the following chunk of code which does not work as most people might expect it to
#cartoon example
a <- c(3,7,11)
f <- list()
#manual initialization
f[[1]]<-function(x) a[1]+x
f[[2]]<-function(x) a[2]+x
f[[3]]<-function(x) a[3]+x
#desired result for the rest of the examples
f[[1]](1)
# [1] 4
f[[3]](1)
# [1] 12
#attempted automation
for(i in 1:3) {
f[[i]] <- function(x) a[i]+x
}
f[[1]](1)
# [1] 12
f[[3]](1)
# [1] 12
Note that we get 12 both times after we attempt to "automate". The problem is, of course, that i isn't being enclosed in the function's private environment. All the functions refer to the same i in the global environment (which can only have one value) since a for loop does not seem to create different environment for each iteration.
sapply(f, environment)
# [[1]]
# <environment: R_GlobalEnv>
# [[2]]
# <environment: R_GlobalEnv>
# [[3]]
# <environment: R_GlobalEnv>
So I though I could get around with with the use of local() and force() to capture the i value
for(i in 1:3) {
f[[i]] <- local({force(i); function(x) a[i]+x})
}
f[[1]](1)
# [1] 12
f[[3]](1)
# [1] 12
but this still doesn't work. I can see they all have different environments (via sapply(f, environment)) however they appear to be empty (ls.str(envir=environment(f[[1]]))). Compare this to
for(i in 1:3) {
f[[i]] <- local({ai<-i; function(x) a[ai]+x})
}
f[[1]](1)
# [1] 4
f[[3]](1)
# [1] 12
ls.str(envir=environment(f[[1]]))
# ai : int 1
ls.str(envir=environment(f[[3]]))
# ai : int 3
So clearly the force() isn't working like I was expecting. I was assuming it would capture the current value of i into the current environment. It is useful in cases like
#bad
f <- lapply(1:3, function(i) function(x) a[i]+x)
#good
f <- lapply(1:3, function(i) {force(i); function(x) a[i]+x})
where i is passed as a parameter/promise, but this must not be what's happening in the for-loop.
So my question is: is possible to create this list of functions without local() and variable renaming? Is there a more appropriate function than force() that will capture the value of a variable from a parent frame into the local/current environment?
This isn't a complete answer, partly because I'm not sure exactly what the question is (even though I found it quite interesting!).
Instead, I'll just present two alternative for-loops that do work. They've helped clarify the issues in my mind (in particular by helping me to understand for the first time why force() does anything at all in a call to lapply()). I hope they'll help you as well.
First, here is one that's a much closer equivalent of your properly function lapply() call, and which works for the same reason that it does:
a <- c(3,7,11)
f <- list()
## `for` loop equivalent of:
## f <- lapply(1:3, function(i) {force(i); function(x) a[i]+x})
for(i in 1:3) {
f[[i]] <- {X <- function(i) {force(i); function(x) a[i]+x}; X(i)}
}
f[[1]](1)
# [1] 4
Second, here is one that does use local() but doesn't (strictly- or literally-speaking) rename i. It does, though, "rescope" it, by adding a copy of it to the local environment. In one sense, it's only trivially different from your functioning for-loop, but by focusing attention on i's scope, rather than its name, I think it helps shed light on the real issues underlying your question.
a <- c(3,7,11)
f <- list()
for(i in 1:3) {
f[[i]] <- local({i<-i; function(x) a[i]+x})
}
f[[1]](1)
# [1] 4
Will this approach work for you?
ff<-list()
for(i in 1:3) {
fillit <- parse(text=paste0('a[',i,']+x' ))
ff[[i]] <- function(x) ''
body(ff[[i]])[1]<-fillit
}
It's sort of a lower-level way to construct a function, but it does work "as you want it to."
An alternative for force() that would work in a for-loop local environment is
capture <- function(...) {
vars<-sapply(substitute(...()), deparse);
pf <- parent.frame();
Map(assign, vars, mget(vars, envir=pf, inherits = TRUE), MoreArgs=list(envir=pf))
}
Which can then be used like
for(i in 1:3) {
f[[i]] <- local({capture(i); function(x) a[i]+x})
}
(Taken from the comments in Josh's answer above)
I'm trying to get the names of arguments in the global environment within a function. I know I can use substitute to get the name of named arguments, but I would like to be able to do the same thing with ... arguments. I kinda got it to work for the first element of ... but can't figure out how to do it for the rest of the elements. Any idea how to get this working as intended.
foo <- function(a,...)
{
print(substitute(a))
print(eval(enquote(substitute(...))))
print(sapply(list(...),function(x) eval(enquote(substitute(x)),env=.GlobalEnv)))
}
x <- 1
y <- 2
z <- 3
foo(x,y,z)
x
y
[[1]]
X[[1L]]
[[2]]
X[[2L]]
The canonical idiom here is deparse(substitute(foo)), but the ... needs slightly different processing. Here is a modification that does what you want:
foo <- function(a, ...) {
arg <- deparse(substitute(a))
dots <- substitute(list(...))[-1]
c(arg, sapply(dots, deparse))
}
x <- 1
y <- 2
z <- 3
> foo(x,y,z)
[1] "x" "y" "z"
I would go with
foo <- function(a, ...) {
print( n <- sapply(as.list(substitute(list(...)))[-1L], deparse) )
n
}
Then
foo(x,y,z)
# [1] "y" "z"
Related question was previously on StackOverflow:
How to use R's ellipsis feature when writing your own function? Worth reading.
Second solution, using match.call
foo <- function(a, ...) {
sapply(match.call(expand.dots=TRUE)[-1], deparse)
}