Using get inside lapply, inside a function - r

this may seem like a overly complicated question, but it has me driving me a little nuts for some time. It is also for curiosity, because I already have a way of doing what I need, so is not that important.
In R, I need a function to return a named list object with all the arguments and the values entered by the user. For this I have made this code (toy example):
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- frm
for (i in 1:length(frm))
parms[[i]] <- get(names(frm)[i])
return(parms)
}
So when this is asked:
> foo(b=0)
$a
[1] 1
$b
[1] 0
$h
[1] "coconut"
This result is perfect. The thing is, when I try to use lapply to the same goal, so as to be a little more efficient (and elegant), it does not work as I want it to:
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- lapply(names(frm), get)
names(parms) <- names(frm)
return(parms)
}
The problem clearly is with the environment in which get evaluates it's first argument (a character string, the name of the variable). This I know in part from the error message:
> foo(b=0)
Error in FUN(c("a", "b", "h")[[1L]], ...) : object 'a' not found
and also, because when in the .GlobalEnv environment there are objects with the right names, foo returns their values instead:
> a <- 100
> b <- -1
> h <- 'wallnut'
> foo(b=0)
$a
[1] 100
$b
[1] -1
$h
[1] "wallnut"
Obviously, as get by default evaluates in the parent.frame(), it searches for the objects in the .GlobalEnv environment, instead of that of the current function. This is strange, since this does not happen with the first version of the function.
I have tried many options to make the function get to evaluate in the right environment, but could not do it correctly (I've tried pos=-2,0,1,2 and envir=NULL as options).
If anyone happen to know a little more than me about environments, specially in this "strange" cases, I would love to know how to solve this.
Thanks for your time,
Juan

Edit of 2013-08-05
Using sapply() instead of lapply(), simplifies this considerably:
foo4 <- function(a=1, b=5, h='coconut') {
frm <- formals(sys.function())
sapply(names(frm), get, envir=sys.frame(sys.parent(0)), simplify=FALSE)
}
foo4(b=0, h='mango')
This, though, without sapply() or lapply() might be the more elegant solution:
foo5 <- function(a=1, b=5, h='coconut') {
modifyList(formals(sys.function()), as.list(match.call())[-1])
}
foo5(b=0, h='mango')
Original post (2011-11-04)
After casting about a bit, this looks to be the best solution.
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- lapply(names(frm), get, envir=sys.frame(sys.parent(0)))
names(parms) <- names(frm)
return(parms)
}
foo(b=0, h='mango')
# $a
# [1] 1
# $b
# [1] 0
# $h
# [1] "mango"
There's some subtle stuff going on here with the way that lapply scopes/evaluates the calls that it constructs. The details are hidden in a call to .Internal(lapply(X, FUN)), but for a taste, compare these two calls:
# With function matched by match.fun, search in sys.parent(0)
foo2 <- function(a=1, h='coconut') {
lapply(names(formals()),
get, envir = sys.parent(0))
}
# With anonymous function, search in sys.parent(2)
foo3 <- function(a=1, h='coconut') {
lapply(names(formals()),
FUN = function(X) get(X, envir = sys.parent(2)))
}
foo4(a=0, h='mango')
foo5(a=0, h='mango')

Just convert the current environment into a list:
foo <- function(a=1, b=5, h='coconut') {
as.list(environment())
}
foo(a = 0, h = 'mango')

This is adapted from #Josh O'Brien's solution above using sapply to automatically assign the correct names to the resulting list (saves one line of code):
foo <- function(a=1, b=5, h='coconut') {
frm <- formals(foo)
parms <- sapply(names(frm), get, envir=sys.frame(sys.parent(-1)), simplify=FALSE)
return(parms)
}

Related

Using R, variadically checking if `exists` [duplicate]

I stacked with trying to pass variable through few functions, and on the final function I want to get the name of the original variable. But it seems like substitute function in R looked only in "local" environment, or just for one level up. Well, let me explain it by code:
fun1 <- function (some_variable) {deparse(substitute(some_variable)}
fun2 <- function (var_pass) { fun1 (var_pass) }
my_var <- c(1,2) # I want to get 'my_var' in the end
fun2 (my_var) # > "var_pass"
Well, it seems like we printing the name of variable that only pass to the fun1. Documentation of the substitute tells us, that we can use env argument, to specify where we can look. But by passing .Global or .BaseNamespaceEnv as an argument to substitute I got even more strange results - "some_variable"
I believe that answer is in this function with using env argument, so, could you please explain me how it works and how can I get what I need. Thanks in advance!
I suggest you consider passing optional name value to these functions. I say this because it seems like you really want to use the name as a label for something in the end result; so it's not really the variable itself that matters so much as its name. You could do
fun1 <- function (some_variable, name=deparse(substitute(some_variable))) {
name
}
fun2 <- function (var_pass, name=deparse(substitute(var_pass))) {
fun1 (var_pass, name)
}
my_var <- c(1,2)
fun2(my_var)
# [1] "my_var"
fun1(my_var)
# [1] "my_var"
This way if you end up having some odd variable name and what to give a better name to a result, you at least have the option. And by default it should do what you want without having to require the name parameter.
One hack, probably not the best way:
fun2 <- function (var_pass) { fun1 (deparse(substitute(var_pass))) }
fun1 <- function (some_variable) {(some_variable))}
fun2(my_var)
# "my_var"
And you could run get on that. But as Paul H, suggests, there are better ways to track variables.
Another approach I'd like to suggest is to use rlang::enexpr.
The main advantage is that we don't need to carry the original variable name in a parameter. The downside is that we have to deal with expressions which are slightly trickier to use.
> fun1 <- function (some_variable) {
message("Entering fun1")
rlang::enexpr(some_variable)
}
> fun2 <- function (var_pass) {
message("Entering fun2")
eval(parse(text=paste0("fun1(", rlang::enexpr(var_pass), ")")))
}
> my_var <- c(1, 2)
> fun1(my_var)
#Entering fun1
my_var
> fun2(my_var)
#Entering fun2
#Entering fun1
my_var
The trick here is that we have to evaluate the argument name in fun2 and build the call to fun1 as a character. If we were to simply call fun1 with enexpr(var_pass), we would loose the notion of fun2's variable name, because enexpr(var_pass) would never be evaluated in fun2:
> bad_fun2 <- function (var_pass) {
message("Entering bad fun2")
fun1(rlang::enexpr(var_pass))
}
> bad_fun2(my_var)
#Entering bad fun2
#Entering fun1
rlang::enexpr(var_pass)
On top of that, note that neither fun1 nor fun2 return variable names as character vectors. The returned object is of class name (and can of course be coerced to character).
The bright side is that you can use eval directly on it.
> ret <- fun2(my_var)
#Entering fun2
#Entering fun1
> as.character(ret)
[1] "my_var"
> class(ret)
[1] "name"
> eval(ret)
[1] 1 2

Converting R function argument into a string

I have a function that looks like
my_function <- function(object)
{
# code goes here
}
I'd like the function (among other things) to print the name of the argument (as passed to the function). So if my function call is:
xxx <- my_function(my_object)
then I'd like to know how to get the function to print out the string "my_object".
Can anyone help please?
A more R-ish solution would be to use substitute (get substitute for obj) in combination with deparse (cast symbol to string):
my_function <- function(obj) {deparse(substitute(obj))}
General R metaprogramming rule: prefer substitute!
my_function(my_object)
## [1] "my_object"
I would suggest next approach which is closer to what you want. For sure you could modify it to obtain other outputs:
#Function
my_function <- function(x)
{
as.character(eval(parse(text=enquo(x)))[2])
}
#Apply
my_function(x = my_object)
Output:
[1] "my_object"
An improvement thanks to #MrFlick is next:
#Function
my_function <- function(x)
{
rlang::as_label(rlang::enquo(x))
}
#Apply
my_function(x = my_object)
Which produces same output with a more elegant style in the function:
[1] "my_object"
To display the entire call use match.call like this:
f <- function(x) { print(match.call()); x }
f(pi)
## f(x = pi)
## [1] 3.141593
IF it is desired to display the call just for debugging without modifying the function itself then use trace:
g <- function(x) x # test function
trace(g)
g(pi)
## trace: g(pi)
## [1] 3.141593

R data.table: evaluating address of an object in parent frame

I'm trying to evaluate an expression containing an address of an object at a parent.frame scope, and am getting weird results:
test2 <- function(d) {
address.current <- address(d) # "0x5595b73aedf8"
address.at.caller <- eval(parse(text="address(df)")) # "0x5595b73aedf8"
address.at.caller2 <- do.call(address, args=list("df"), envir=parent.frame()) # problem: "0x5595b6d89de8"
}
test1 <- function(df) {
test2(df)
}
df <- data.frame(a=1:2)
test1(df)
Moreover, if you stop at a breakpoint inside test2 and re-evaluate the expression for address.at.caller2 you'd get non-repeating results:
Browse[2]> do.call(address, args=list("df"), envir=parent.frame())
[1] "0x5595b8c37d78"
Browse[2]> do.call(address, args=list("df"), envir=parent.frame())
[1] "0x5595b8cc74a8"
Browse[2]> do.call(address, args=list("df"), envir=parent.frame())
[1] "0x5595b8cd1348"
This seems to indicate that the result is an address of some temporary object. (Evaluate repeatedly address(2) for a different example).
Is something wrong with the expression do.call(address, args=list("df"), envir=parent.frame())?
Is there a different explanation for this behaviour?
Its not really clear what you are trying to do by using do.call. When you use it like you did, you gave it a variable ( a string) and you asked it for the address. the thing is that R automatically creates copies when you enter variables into functions. So when you gave args = list("df) what R did was create a copy of the string "df" within the do.call frame, and then it gave you the local address before closing the call. You should pass the variable you want to evaluate into the function, or alternatively have it sit on the global scope.
Interesting question.
You don't have to pass input variable really, or operate on the global scope. You can use a more robust alternative to do.call, the eval(as.call(.)).
test2 <- function(d) {
address.current <- address(d)
print(address.current)
address.at.caller <- eval(parse(text="address(df)"))
print(address.at.caller)
address.at.caller2 <- do.call(address, args=list("df"), envir=parent.frame())
print(address.at.caller2)
address.at.caller3 = eval.parent(as.call(list(quote(address), as.name("df"))))
print(address.at.caller3)
}
test1 <- function(df) {
test2(df)
}
df <- data.frame(a=1:2)
test1(df)
[1] "0x560d46e33cc0"
[1] "0x560d46e33cc0"
[1] "0x560d46e4a5f8"
[1] "0x560d46e33cc0"

Can I access the assignment of a function from inside that function? [duplicate]

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"

Get the names of list variables when provided as function parameters

Lets say I have a function that accepts variables that are always part of a list.
myfun <- function(x$name,y$name) {
# stuff
}
What I'd like to do is get the names used.
alist <- list(Hello=1,Goodbye=2)
myfun(alist$Hello, alist$Goodbye) {
# I want to be able to work with the characters "Hello" and "Goodby" in here
}
So, within my function, how would I get the characters "Hello" and "Goodbye". Given alist$Hello and alist$Goodbye
I recall that plot.default does this with deparse(substitute(:
a <- list(a="hello",b=c(1,2,3))
f <- function(x,y) { print(deparse(substitute(x))); print(deparse(substitute(y))) }
f(a$a,a$b)
#[1] "a$a"
#[1] "a$b"
Something like this, perhaps:
myfun <- function(x) { print(substitute(x))}
myfun(iris$Sepal.Length)
## iris$Sepal.Length
I'd create the function with a list argument:
myfun <- function(l) {
print(names(alist))
}
myfun(alist)
# [1] "Hello" "Goodbye"

Resources