I want to "overload" a function, with a try and catch feature.
This is a "low-sense example" but if i solve this i have a solution for my real problem.
write.csv2 <- function(...) {
utils::write.csv2(x = ..1,paste0("GET.THE.NAME.OF.THE.X_arg",".csv"))
}
write.csv2(x=mtcars)
The result of the above function call should end up in a CSV-file that is called "mtcars.csv"
If i call write.csv(x=DATAdata) there should be a csv called DATAdata.csv
I tried:
deparse(substitute()) and other stuff. Nothing worked to far.
edit:
why does it not work?
write.csv2 <- function(...) {
utils::write.csv2(x = ..1,file = paste0(deparse(substitute(..1)),".csv"))
}
write.csv2(x=mtcars)
Generally I convert ... to a named list:
fun1 <- function(...){
argv <- list(...)
return(argv)
}
This means you can reference your variables from the list by the name you give them in the function call:
> fun1(filename='mtcars.csv')
$filename
[1] "mtcars.csv"
or a bit more sophisticated:
fun2 <- function(...){
argv <- list(..)
write.csv(argv$x,argv$filename)
}
With the call fun2(x=runif(100),filename='randomnumbers.csv')
How about something like this.
write.csv2 <- function(...) {
call <- match.call(utils::write.csv2)
call[[1]] <- utils::write.csv2
call$file = paste0(deparse(call[[2]]), ".csv")
eval.parent(call)
}
write.csv2(mtcars)
Here we capture call the call, re-write the file= parameter and pass it along to the real function.
Related
I am using a package that has 2 functions which ultimately look like the following:
pkgFun1 <- function(group) {
call <- match.call()
pkgFun2(call)
}
pkgFun2 <- function(call) {
eval(call$group)
}
If I just call pkgFun1(group = 2), it works fine. But I want to call it from a function:
myFun <- function(x) {
pkgFun1(group = x)
}
myFun(x = 2)
## Error in eval(call$group) : object 'x' not found
Is there any way to avoid this error, if I can't modify the package functions, but only myFun?
There are similar questions, such as Issue with match.call or Non-standard evaluation in a user-defined function with lapply or with in R, but my particular issue is that I can't modify the part of code containing the eval call.
It's pkgFun2 that is wrong, so I think you're out of luck without some weird contortions. It needs to pass the appropriate environment to eval(); if you can't modify it, then you can't fix it.
This hack might appear to work, but in real life it doesn't:
pkgFun1 <- function(group) {
call <- match.call()
f <- pkgFun2
environment(f) <- parent.frame()
f(call)
}
With this, you're calling a copy of pkgFun2 modified so its environment is appropriate to evaluate the call. It works in the test case, but will cause you untold grief in the future, because everything that is not local in pkgFun2 will be searched for in the wrong place. For example,
myFun <- function(x) {
eval <- function(...) print("Gotcha!")
pkgFun1(group = x)
}
myFun(x = 2)
# [1] "Gotcha!"
Best is to fix pkgFun2. Here's one fix:
pkgFun1 <- function(group) {
call <- match.call()
pkgFun2(call, parent.frame())
}
pkgFun2 <- function(call, envir) {
eval(call$group, envir = envir)
}
Edited to add: Actually, there is another hack that is not so weird that should work with your original pkgFun1 and pkgFun2. If you force the evaluation of x to happen in myFun so that pkgFun1 never sees the expression x, it should work. For example,
myFun <- function(x) {
do.call("pkgFun1", list(group = x))
}
If you do this, then after myFun(2), the pkgFun1 variable call will be pkgFun1(group = 2) and you won't get the error about x.
I am currently writing a function that will take an equation as an argument. The function will expect variables to be apart of the column names of data.
mydata <- data.frame(x=c(1,2,3,4),y=c(5,6,7,8), z=c(9,10,11,12))
my_function <- function(data, equ) {
EQU.sub <- deparse(substitute(equ))
#Check if colnames are used
for(i in 1:length(colnames(data)) {
if(str_detect(string = EQU.sub, pattern = colnames(data)[i])) {
#if used, create variable with its name.
assign(x = colnames(data)[i],
value = eval(parse(text = paste("data$",
colnames(data),
sep = ""))))
} else {
warning(paste(colnames[i], "was not used in EQU"))
}
}
df$new.value <- eval(equ)
output <- function(new.equ = equ)
return(df)
}
my_function(data = mydata, equ = x+(y^2))
I know what you may be thinking, this is a big workaround for just doing
mydata$x+(mydata$y^2)
THE ISSUE
The issue is that I want to pass my input of equ into an new function.
new_function <- function(new.equ) {
string <- deparse(substitute(new.equ))
#does some stuff....
return(output) }
however, when changing from execution environment of my_function to new_function, calling deparse(substitute(equ)) returns "equ" instead of "x+(y^2)"
I know that the function substitute returns what was explicitly assigned to the variable. (equ) but I am wondering if there is a way for new_function() to be able to see into the execution environment of my_function() so I can get the desired output of "x+(y^2)"
UPDATE
After thinking about it, I could change what I pass to new.equ to the deparsed version of equ as follows...
output <- function(new.equ = EQU.sub)
new_function <- function(new.equ) {
#given that these variables are available
value <- parse(text = new.equ)
#does some stuff....
return(output) }
but my original question still stands because I'm still new to R environments. Is there a more elegant way to go through execution environments?
Using non-standard evaulation like this can be pretty messy. Rather than trying to capture expressions from promises passed to functions, it's much safer just to pass a formula. For example
mydata <- data.frame(x=c(1,2,3,4),y=c(5,6,7,8), z=c(9,10,11,12))
my_function <- function(data, equ) {
stopifnot(inherits(equ, "formula"))
eval(equ[[2]], data)
}
new_function <- function(newequ) {
my_function(mydata, newequ)
}
my_function(mydata, ~x+(y^2))
new_function(~x+(y^2))
Or give your function an extra parameter where you can pass an expression instead so you don't have to rely on a promise. This makes it much easier to write other functions that can call your function.
my_function <- function(data, equ, .equ=substitute(equ)) {
eval(.equ, data)
}
new_function <- function(newequ) {
equ <- substitute(newequ)
my_function(mydata, .equ=equ)
}
my_function(mydata, x+(y^2))
new_function(x+(y^2))
my_function(mydata, .equ=quote(x+(y^2)))
Say I have two functions whose names are contained within a vector. I would like to test if each function works.
My approach, which I readily admit could be wrong, was to loop through the vector then paste () to the function name. But then I realized I have no idea how to evaluate the function call which is current stored as a string. Here is a reprex:
func1 <- function(){
message("func1 works")
}
func2 <- function(){
message("func2 works")
}
fv <- c("func1","func2")
for(i in seq_along(fv)){
fv_func <- paste0(fv[i],"()")
print(fv_func)
}
[1] "func1()"
[1] "func2()"
So in this context I am asking how to evaluate func1() and func2() though the ultimate goal is to evaluate function whose names are stored in a vector - meaning i'm open to better solution.
If you have the names of the functions as strings you can get() them:
fv <- c("func1","func2")
for(i in seq_along(fv)){
fv_func <- get(fv[i])
# Can just call normally, no need to paste () on
fv_func()
}
Try either of these:
out <- lapply(fv, do.call, list())
out <- lapply(fv, function(f) match.fun(f)())
We can do it in one line without a for loop if we use vectorised eval(parse):
eval(parse(text = paste0(fv,'()')))
Is it possible in R to run some code when calling a missing (yet undefined) function or when evaluating an inexistent symbol?
Or: is there any way to load a library in such a situation?
In the end, I would like to have something like this:
autoload.table <- list(foo = source("foo.R"), bar = library("bar"))
foo()
#=> load "foo.R" and evaluate `foo()`
edit:
Building on the solution by #Miff, I came up with this function, which avoids the string mangling:
tAutoload <- function (name, expr) {
cl <- as.list(match.call())
sname <- as.character(cl$name)
if (!exists(sname)) {
assign(sname,
eval(substitute(function (...) {
rm(name)
expr
name(...)
})), envir = .GlobalEnv)
}
}
This can be used as follows:
tAutoload(foo, source("foo.R"))
tAutoload(bar, library("bar"))
Upon first invocation, e.g., foo() will remove itself and then execute the assigned action.
I'm not sure how generally applicable this code is - I think it may not be robust to a different types of argument matching in foo and bar, but how about something like this:
at <- list(foo = 'source("foo.R")', qplot = 'library(ggplot2)') #too lazy to type autoloader.tablF
for (i in 1:length(at))
assign(names(at)[i], eval(parse(text=paste0("function(...){ rm(",names(at)[i],",envir=.GlobalEnv);",at[[i]],"; ",names(at)[i],"(...) }")),envir=.GlobalEnv))
What does that mess do? For each element in the at list, create a function in the global environment, which deletes itself, runs the code from at[[i]], then runs the function again, with the arguments originally used, which should now call the new version loaded. So foo now has the value:
function(...){ rm(foo,envir=.GlobalEnv);source("foo.R"); foo(...) }
Example:
> foo
function(...){ rm(foo,envir=.GlobalEnv);source("foo.R"); foo(...) }
> foo(1)
fooing 1
> foo
function(x) cat("fooing", x, "\n") #Now imported from foo.R
or for qplot:
> qplot
function(...){ rm(qplot,envir=.GlobalEnv);library(ggplot2); qplot(...) }
> qplot(diamonds$cut, diamonds$carat) #produces a plot
> qplot #now prints definition from ggplot2
Create a blank function!
foo <- function(){ }
I have a question with importing functions.
Say I have a R script named "functions" which looks like this:
mult <- function(x,y){
return(x*y)
}
divide <- function(x,y){
return(x/y)
}
Currently I am importing all functions in the script:
source(file="C:\\functions.R",echo=FALSE)
The problem is that the (actual) R script is getting very large.
Is there a way to import the "mult" function only?
I was looking at evalSource/insertSource but my code was not working:
insertSource("C:\\functions.R", functions="mult")
It looks like your code will work with a slight change: define an empty object for the function you want to load first, then use insertSource.
mult <- function(x) {0}
insertSource("C:\\functions.R", functions="mult")
mult
Which gives:
Object of class "functionWithTrace", from source
function (x, y)
{
return(x * y)
}
## (to see original from package, look at object#original)
The mult object has some additional information that I suppose is related to the original application for insertSource, but you could get rid of them with mult <- mult#.Data, which will set mult to the actual function body only.
Also, you might be interested in the modules project on github, which is trying to implement a lightweight version of R's package system to facilitate code reuse. Seems like that might be relevant, although I think you would have to split your functions into separate files in different subdirectories.
I ended up creating functions to do what you recommended.
This first group allows for multiple functions in one call:
LoadFunction <- function(file,...) {
dots <- match.call(expand.dots = FALSE)$...
dots <- sapply(dots, as.character)
output <- lapply(dots, function(x,file){eval(parse(text=paste(x," <- function(x) {0}",sep="")),envir = .GlobalEnv)
suppressMessages(insertSource(file, functions=x))
eval(parse(text=paste(x," <- ",x,"#.Data",sep="")),envir = .GlobalEnv) },file=file)
}
UnloadFunction <- function(...) {
dots <- match.call(expand.dots = FALSE)$...
dots <- sapply(dots, as.character)
output <- lapply(dots, function(x,file){eval(parse(text=paste("rm(",x,",envir = .GlobalEnv)",sep="")))},file=file)
}
They are called like this:
LoadFunction(file="C:\\functions.R",mult,divide)
UnloadFunction(mult,divide)
The second is only one function per call:
LoadFunction2 <- function(file,function_name) {
eval(parse(text=paste(function_name," <- function(x) {0}",sep="")),envir = .GlobalEnv)
suppressMessages(insertSource(file, functions=function_name))
eval(parse(text=paste(function_name," <- ",function_name,"#.Data",sep="")),envir = .GlobalEnv)
}
UnloadFunction2 <- function(function_name) {
eval(parse(text=paste("rm(",function_name,",envir = .GlobalEnv)",sep="")))
}
They are called like this:
LoadFunction2(file="C:\\functions.R","mult")
LoadFunction2(file="C:\\functions.R","divide")
UnloadFunction2("mult")
UnloadFunction2("divide")