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"
Related
In a for loop I make a "string-formula" and allocate it to e.g. body1. And when I try to make a function with that body1 it fails... And I have no clue what I should try else...
This question How to create an R function programmatically? helped me a lot but sadly only quote is used to set the body...
I hope you have an idea how to work around with this issue.
And now my code:
A.m=matrix(c(3,4,2,2,1,1,1,3,2),ncol=3,byrow=TRUE)
for(i in 1:dim(A.m)[1]) {
body=character()
# here the string-formula emerges
for(l in 1:dim(A.m)[2]) {
body=paste0(body,"A.m[",i,",",l,"]","*x[",l,"]+")
}
# only the last plus-sign is cutted off
assign(paste0("body",i),substr(body,1,nchar(body)-1))
}
args=alist(x = )
# just for your convenience the console output
body1
## [1] "A.m[1,1]*x[1]+A.m[1,2]*x[2]+A.m[1,3]*x[3]"
# in this code-line I don't know how to pass body1 in feasible way
assign("Function_1", as.function(c(args, ???body1???), env = parent.frame())
And this is my aim:
Function_1(x=c(1,1,1))
## 9 # 3*1 + 4*1 + 2*1
Since you have a string, you need to parse that string. You can do
assign("Function_1",
as.function(c(args, parse(text=body1)[[1]])),
env = parent.frame())
Though I would strongly discourage the use of assign for filling your global environment with a bunch of variables with indexes in their name. In general that makes things much tougher to program with. It would be much easier to collect all your functions in a list. For example
funs <- lapply(1:dim(A.m)[1], function(i) {
body <- ""
for(l in 1:dim(A.m)[2]) {
body <- paste0(body,"A.m[",i,",",l,"]","*x[",l,"]+")
}
body <- substr(body,1,nchar(body)-1)
body <- parse(text=body)[[1]]
as.function(c(alist(x=), body), env=parent.frame())
})
And then you can call the different functions by extracting them with [[]]
funs[[1]](x=c(1,1,1))
# [1] 9
funs[[2]](x=c(1,1,1))
# [1] 4
Or you can ever call all the functions with an lapply
lapply(funs, function(f, ...) f(...), x=c(1,1,1))
# [[1]]
# [1] 9
# [[2]]
# [1] 4
# [[3]]
# [1] 6
Although if this is actually what your function is doing, there are easier ways to do this in R using matrix multiplication %*%. Your Function_1 is the same as A.m[1,] %*% c(1,1,1). You could make a generator funciton like
colmult <- function(mat, row) {
function(x) {
as.numeric(mat[row,] %*% x)
}
}
And then create the same list of functions with
funs <- lapply(1:3, function(i) colmult(A.m, i))
Then you don't need any string building or parsing which tends to be error prone.
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"
Imagine you have a simple function that specifies which statistical tests to run for each variable. Its syntax, simplified for the purposes of this question is as follows:
test <- function(...) {
x <- list(...)
return(x)
}
which takes argument pairs such as Gender = 'Tukey', and intends to pass its result to other functions down the line. The output of test() is as follows:
test(Gender = 'Tukey')
# $Gender
# [1] "Tukey"
What is desired is the ability to replace the literal Gender by a dynamically assigned variable varname (e.g., for looping purposes). Currently what happens is:
varname <- 'Gender'
test(varname = 'Tukey')
# $varname
# [1] "Tukey"
but what is desired is this:
varname <- 'Gender'
test(varname = 'Tukey')
# $Gender
# [1] "Tukey"
I tried tinkering with functions such as eval() and parse(), but to no avail. In practice, I resolved the issue by simply renaming the resulting list, but it is an ugly solution and I am sure there is an elegant R way to achieve it. Thank in advance for the educational value of your answer.
NB: This question occurred to me while trying to program a custom function which uses mcp() from the effects package in its internals. The said mcp() function is the real world counterpart of test().
EDIT1: Perhaps it needs to be clarified that (for educational purposes) changing test() is not an option. The question is about how to pass the tricky argument to test(). If you take a look at NB, it becomes clear why: the real world counterpart of test(), namely mcp(), comes with a package. And while it is possible to create a modified copy of it, I am really curious whether there exists a simple solution in somehow 'converting' the dynamically assigned variable to a literal in the context of dot-arguments.
This works:
test <- function(...) {
x = list(...)
names(x) <- sapply(names(x),
function(p) eval(as.symbol(p)))
return(x)
}
apple = "orange"
test(apple = 5)
We can use
test <- function(...) {
x <- list(...)
if(exists(names(x))) names(x) <- get(names(x))
x
}
test(Gender = 'Tukey')
#$Gender
#[1] "Tukey"
test(varname = 'Tukey')
#$Gender
#[1] "Tukey"
What about this:
varname <- "Gender"
args <- list()
args[[varname]] <- "Tukey"
do.call(test, args)
I have loaded in a R console different type of objects.
I can remove them all using
rm(list=ls())
or remove only the functions (but not the variables) using
rm(list=lsf.str())
My question is:
is there a way to remove all variables except the functions
Here's a one-liner that removes all objects except for functions:
rm(list = setdiff(ls(), lsf.str()))
It uses setdiff to find the subset of objects in the global environment (as returned by ls()) that don't have mode function (as returned by lsf.str())
The posted setdiff answer is nice. I just thought I'd post this related function I wrote a while back. Its usefulness is up to the reader :-).
lstype<-function(type='closure'){
inlist<-ls(.GlobalEnv)
if (type=='function') type <-'closure'
typelist<-sapply(sapply(inlist,get),typeof)
return(names(typelist[typelist==type]))
}
You can use the following command to clear out ALL variables. Be careful because it you cannot get your variables back.
rm(list=ls(all=TRUE))
Here's a pretty convenient function I picked up somewhere and adjusted a little. Might be nice to keep in the directory.
list.objects <- function(env = .GlobalEnv)
{
if(!is.environment(env)){
env <- deparse(substitute(env))
stop(sprintf('"%s" must be an environment', env))
}
obj.type <- function(x) class(get(x, envir = env))
foo <- sapply(ls(envir = env), obj.type)
object.name <- names(foo)
names(foo) <- seq(length(foo))
dd <- data.frame(CLASS = foo, OBJECT = object.name,
stringsAsFactors = FALSE)
dd[order(dd$CLASS),]
}
> x <- 1:5
> d <- data.frame(x)
> list.objects()
# CLASS OBJECT
# 1 data.frame d
# 2 function list.objects
# 3 integer x
> list.objects(env = x)
# Error in list.objects(env = x) : "x" must be an environment
I wrote this to remove all objects apart from functions from the current environment (Programming language used is R with IDE R-Studio):
remove_list=c() # create a vector
for(i in 1:NROW(ls())){ # repeat over all objects in environment
if(class(get(ls()[i]))!="function"){ # if object is *not* a function
remove_list=c(remove_list,ls()[i]) # ..add to vector remove_list
}
}
rm(list=remove_list) # remove all objects named in remove_list
Notes-
The argument "list" in rm(list=) must be a character vector.
The name of an object in position i of the current environment is returned from ls()[i] and the object itself from get(ls()[i]). Therefore the class of an object is returned from class(get(ls()[i]))
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)
}