I would like to have a function which calls subset, and passes on a subset argument:
df <- data.frame(abc=c("A","A","B","B"),value=1:4)
subset(df,abc=="A")
## works of course:
# abc value
#1 A 1
#2 A 2
mysubset <- function(df,ssubset)
subset(df,ssubset)
mysubset(df,abc=="A")
## Throws an error
# Error in eval(expr, envir, enclos) : object 'abc' not found
mysubset2 <- function(df,ssubset)
subset(df,eval(ssubset))
mysubset2(df,expression(abc=="A"))
## Works, but needs expression
I tried with substitute, but was not able to find the right combination. How can I get this working?
You need eval() and parse() in there too:
mysubset <- function(df, ssubset) {
subset(df, eval(parse(text=ssubset)))
}
mysubset(df, "abc=='A'")
# abc value
# 1 A 1
# 2 A 2
Note that you need to nest quotes, so switch back and forth between " and ' as necessary.
Based on your comment, perhaps something like this is also of interest:
mysubset <- function(df, ...) {
ssubset <- deparse(substitute(...))
subset(df, eval(parse(text = ssubset)))
}
USAGE: mysubset(df, abc=='A')
The A5C1D2H2I1M1N2O1R2T1 answer works, but you can skip the whole deparse/parse cycle by simply using:
mysubset <- function(df, p) {
ps <- substitute(p)
subset(df, eval(ps))
}
Related
I am trying to catch the name of a variable passed to a function, the right way. The name of interest noi is a data frame column or a vector. Below is my minimum working example. Ideally, I would like to receive a character vector which contains only "noi"
library(dplyr)
df <- data.frame(noi = seq(1:3))
example_fun <- function( x ){
deparse(substitute(x))
}
The result depends on the way I structure my input. Now I have an idea why this happens, but how would I do it correctly to have the desired result, regardless of how I call the function.
# Base
example_fun(df$noi)
[1] "df$noi"
# Pipe
df$noi %>% example_fun()
[1] "."
# Mutate
df %>% mutate(example_fun(noi))
noi example_fun(noi)
1 1 noi
2 2 noi
3 3 noi
Thanks in advance!
Perhaps decorate that variable with a "comment" attribute in another function? Note that the variable you want to decorate has to be wrapped directly in the decoration function z; otherwise, an error is raised (by design and for robustness).
example_fun <- function(x){
attr(x, "comment")
}
z <- function(x) {
nm <- substitute(x)
nm <- as.character(
if (is.symbol(nm) && !identical(nm, quote(.))) {
nm
} else if (length(nm) > 1L && (identical(nm[[1L]], quote(`[[`)) || identical(nm[[1L]], quote(`$`)))) {
tail(nm, 1L)
} else {
stop("not a valid symbol or extract operator.", call. = match.call())
}
)
`comment<-`(x, nm)
}
Output
> example_fun(z(df$noi))
[1] "noi"
> z(df$noi) %>% (function(x) x + 1) %>% example_fun()
[1] "noi"
> df %>% mutate(example_fun(z(noi)))
noi example_fun(z(noi))
1 1 noi
2 2 noi
3 3 noi
> z(df[["noi"]]) %>% example_fun()
[1] "noi"
> with(df, z(noi)) %>% example_fun()
[1] "noi"
> z(with(df, noi)) %>% example_fun()
Error in z(with(df, noi)) : not a valid symbol or extract operator.
> df$noi %>% z()
Error in z(.) : not a valid symbol or extract operator.
... but this may not be a robust method. It is extremely difficult to achieve what you want in a robust way, especially when a pipeline is involved. I think you should read Hadley's Advanced R and learn more about how bindings and environments work.
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"
The first call to the function f works, the second does not. How can I pass a String ("v") to the function f so that the function works as exspected?
library(data.table)
f<-function(t,x) t[,deparse(substitute(x)),with=F]
dat<-data.table(v="a")
f(dat,v)
# v
# 1: a
f(dat,eval(parse(text="v")))
# Error in `[.data.table`(t, , deparse(substitute(x)), with = F) :
# column(s) not found: eval(parse(text = "v"))
It won't be a one-liner anymore but you can test for what you're passing in:
library(data.table)
library(purrr)
dat <- data.table(v="a")
f <- function(dt, x) {
# first, see if 'x' is a variable holding a string with a column name
seval <- safely(eval)
res <- seval(x, dt, parent.frame())
# if it is, then get the value, otherwise substitute() it
if ((!is.null(res$result)) && inherits(res$result, "character")) {
y <- res$result
} else {
y <- substitute(x)
}
# if it's a bare name, then we deparse it, otherwise we turn
# the string into name and then deparse it
if (inherits(y, "name")) {
y <- deparse(y)
} else if (inherits(y, "character")) {
y <- deparse(as.name(x))
}
dt[, y, with=FALSE]
}
f(dat,v)
## v
## 1: a
f(dat, "v")
## v
## 1: a
V <- "v"
f(dat, V)
## v
## 1: a
f(dat, VVV)
#> throws an Error
I switched it from t to dt since I don't like using the names of built-in functions (like t()) as variable names unless I really have to. It can introduce subtle errors in larger code blocks that can be frustrating to debug.
I'd also move the safely() call outside the f() function to save a function call each time you run f(). You can use old-school try() instead, if you like, but you have to check for try-error which may break some day. You could also tryCatch() wrap it, but the safely() way just seems cleaner to me.
Thanks in advance, and sorry if this question has been answered previously - I have looked pretty extensively. I have a dataset containing a row of with concatenated information, specifically: name,color code,some function expression. For example, one value may be:
cost#FF0033#log(x)+6.
I have all of the code to extract the information, and I end up with a vector of expressions that I would like to convert to a list of actual functions.
For example:
func.list <- list()
test.func <- c("x","x+1","x+2","x+3","x+4")
where test.func is the vector of expressions. What I would like is:
func.list[[3]]
To be equivalent to
function(x){x+3}
I know that I can create a function using:
somefunc <- function(x){eval(parse(text="x+1"))}
to convert a character value into a function. The problem comes when I try and loop through to make multiple functions. For an example of something I tried that didn't work:
for(i in 1:length(test.func)){
temp <- test.func[i]
f <- assign(function(x){eval(expr=parse(text=temp))})
func.list[[i]] <- f
}
Based on another post (http://stats.stackexchange.com/questions/3836/how-to-create-a-vector-of-functions) I also tried this:
makefunc <- function(y){y;function(x){y}}
for(i in 1:length(test.func)){
func.list[[i]] <- assign(x=paste("f",i,sep=""),value=makefunc(eval(parse(text=test.func[i]))))
}
Which gives the following error: Error in eval(expr, envir, enclos) : object 'x' not found
The eventual goal is to take the list of functions and apply the jth function to the jth column of the data.frame, so that the user of the script can specify how to normalize each column within the concatenated information given by the column header.
Maybe initialize your list with a single generic function, and then update them using:
foo <- function(x){x+3}
> body(foo) <- quote(x+4)
> foo
function (x)
x + 4
More specifically, starting from a character, you'd probably do something like:
body(foo) <- parse(text = "x+5")
Just to add onto joran's answer, this is what finally worked:
test.data <- matrix(data=rep(1,25),5,5)
test.data <- data.frame(test.data)
test.func <- c("x","x+1","x+2","x+3","x+4")
func.list <- list()
for(i in 1:length(test.func)){
func.list[[i]] <- function(x){}
body(func.list[[i]]) <- parse(text=test.func[i])
}
processed <- mapply(do.call,func.list,lapply(test.data,list))
Thanks again, joran.
This is what I do:
f <- list(identity="x",plus1 = "x+1", square= "x^2")
funCreator <- function(snippet){
txt <- snippet
function(x){
exprs <- parse(text = txt)
eval(exprs)
}
}
listOfFunctions <- lapply(setNames(f,names(f)),function(x){funCreator(x)}) # I like to have some control of the names of the functions
listOfFunctions[[1]] # try to see what the actual function looks like?
library(pryr)
unenclose(listOfFunctions[[3]]) # good way to see the actual function http://adv-r.had.co.nz/Functional-programming.html
# Call your funcions
listOfFunctions[[2]](3) # 3+1 = 4
do.call(listOfFunctions[[3]],list(3)) # 3^2 = 9
attach(listOfFunctions) # you can also attach your list of functions and call them by name
square(3) # 3^2 = 9
identity(7) # 7 ## masked object identity, better detach it now!
detach(listOfFunctions)
I have defined a function called once as follows:
once <- function(x, value) {
xname <- deparse(substitute(x))
if(!exists(xname)) {
assign(xname, value, env=parent.frame())
}
invisible()
}
The idea is that value is time-consuming to evaluate, and I only want to assign it to x the first time I run a script.
> z
Error: object 'z' not found
> once(z, 3)
> z
[1] 3
I'd really like the usage to be once(x) <- value rather than once(x, value), but if I write a function once<- it gets upset that the variable doesn't exist:
> once(z) <- 3
Error in once(z) <- 3 : object 'z' not found
Does anyone have a way around this?
ps: is there a name to describe functions like once<- or in general f<-?
If you are willing to modify your requirements slightly to use square brackets rather than parentheses then you could do this:
once <- structure(NA, class = "once")
"[<-.once" <- function(once, x, value) {
xname <- deparse(substitute(x))
pf <- parent.frame()
if (!exists(xname, pf)) assign(xname, value, pf)
once
}
# assigns 3 to x (assuming x does not currently exist)
once[x] <- 3
x # 3
# skips assignment (since x now exists)
once[x] <- 4
x # 3
As per item 3.4.4 in the R Language Reference, something like a names replacement is evaluated like this:
`*tmp*` <- x
x <- "names<-"(`*tmp*`, value=c("a","b"))
rm(`*tmp*`)
This is bad news for your requirement, because the assignment will fail on the first line (as x is not found), and even if it would work, your deparse(substitute) call will never evaluate to what you want it to.
Sorry to disappoint you