I am working on a function that would behave similar to Reduce where you pass in a function and dispatch it over the arguments. Here is simple example to demonstrate what I am working on.
fun <- function(f){
switch(f,
`+` = "addition",
stop("undefined")
)
}
fun(`+`)
Now this clearly won't work as it stands because switch requires a character or numeric EXPR. What I don't know how to do is convert the function f that is passed to fun to a string.
One approach is to capture the input and deparse the call.
fun <- function(f){
switch(deparse(substitute(f)),
`+` = "addition",
stop("undefined")
)
}
fun(`+`)
#[1] "addition"
Going off of Pierre's comment above, one can use identical to test whether two functions are the same. This doesn't work well with switch, but an if/else tree is still relatively simple:
fun <- function(f) {
if (identical(f, `+`)) {
return('addition')
} else if (identical(f, mean)) {
return('mean')
} else {
return('undefined')
}
}
Related
I have a function myfun which among other arguments has one that is a user supplied function, say f. This function may have any number of arguments, including maybe none. Here is a simple example:
myfun = function(f, ...) { f()}
Now calls to myfun might be
myfun( f=function() rnorm(10) )
myfun( f=function(m) rnorm(10, m) )
I don't want to use the ellipse argument ... inside of f, so my question is whether there is any other way to determine inside of myfun how many arguments the function f has? If f has no arguments it is then passed to the Rcpp routine doA.cpp, but if it has one or more arguments it is passed to doB.cpp. So I need to know inside myfun which it is.
Here is a toy example which hopefully makes it clearer what I am after:
myfun = function(f) {
numarg = number.of.arguments(f)
if(numarg==0) return(doA.cpp(f))
else return(doB.cpp(f))
}
so I need a "function" number.of.arguments, that is some way to determine numarg.
Based on your specific use-case, your best bet might be to query the formal arguments of f. However, note that there are several caveats with this method, which I note below.
f = function (f) {
if (length(formals(f)) == 0L) {
doA.cpp(f)
} else {
doB.cpp(f)
}
}
The caveats are that formals does not work for primitive functions: formals(mean) works, but formals(sum) returns NULL. Furthermore, formals counts ... as a single argument. So if you want to handle ... differently you'll have to do this manually:
if ('...' %in% names(formals(f))) {
# `...` is present
} else {
# `...` is not present
}
A more robust method when the user supplies the arguments is to find the length of the ... args via ...length().
You could then pass the ... arguments to doB.cpp inside a list, for instance:
myfun = function(f, ...) {
if (...length() == 0L) {
doA.cpp(f)
} else {
doB.cpp(f, list(...))
}
}
Konrad's is just what I need! Also, I learned about the formals function, which I had not seen before. Its limitations as discussed by Konrad won't matter for my case because the functions are ones the users have to write anyway, and I won't use ... . So, thanks!
Wolfgang
This is what I may code in R.
myfun = function(f, ...) { f(...)}
myfun( f=function(m) rnorm(10, m), m )
After getting comment from #Wolfgang Rolke, the question becomes better understood. Here is my second attempt.
myfun = function(f, ...) {
argg <- c(as.list(environment()), list(...))
numarg=length(argg)
if (numarg==1) { return( f()) }
if (numarg==2) { return(f(argg[[2]])) }
}
myfun( f=function() rnorm(10) )
myfun( f=function(m=2) rnorm(10, m) )
To easily verify the result, one may do the following:
myfun( f=function() mean(rnorm(10))) # it returns something like 0.07599287
myfun( f=function(m=10) mean(rnorm(10, m))) # it returns 9.49364
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)))
I have a function that takes an input of a function.
myfunc <- function(FUN){}
There, I want to check if FUN is a mean, and perform some more task
myfunc <- function(FUN){
``some tasks here``
if(FUN==mean){``some more task here``} # this FUN==mean is not valid
}
However, it seems FUN can't be compared with this way. Is there a way to check if a specific function is inputed?
Uses checkmate::assert_function() for a little extra security.
myfunc <- function(FUN){
checkmate::assert_function(mean)
if( identical(FUN, base::mean) ){
return( TRUE )
} else {
return( FALSE )
}
}
myfunc(mean) # TRUE
myfunc(meanie) # FALSE
This SO question prompts the substitute() and alternative solutions in a slightly more complicated scenario.
edit: followed #spacedman's advice and replaced substitute(FUN) == "mean" inside the 'if' condition to make it more robust (particularly against sociopaths who name their function to mask base::mean()).
I recently (very) started looking into creating S3 functions in R. I am working in a function where I foresee having common operations between different methods. Not sure how this should be done. For example:
myfun <- function (x) {
UseMethod("myfun")
}
myfun.numeric <- function(x) {
a<-x+5
b<-a^2
c<-b+4
d<-c-3
d
}
myfun.character <- function(x) {
a<-as.numeric(x)+9
b<-a^2
c<-b+4
d<-c-3
d
}
myfun("3")
myfun(3)
The function at this time is not too long. I guess technically I can have a function that perform the part represented by letter "a" then have a common function that perform steps "b", "c", and "d". In some cases the functions could be quite short and having an additional function seems not to be the best practice. What is usually done in cases like this?
Here are two possibilities. There is some danger in using the default method since it might get invoked in unanticipated situations so the common function seems more reliable but either would work in the example you show.
1) default method Put the common code in the default method and use NextMethod().
myfun <- function (x) UseMethod("myfun")
myfun.numeric <- function(x) {
x<-x+5
NextMethod()
}
myfun.character <- function(x) {
x <-as.numeric(x)+9
NextMethod()
}
myfun.default <- function(x) {
b<-x^2
c<-b+4
d<-c-3
d
}
myfun("3")
myfun(3)
2) common function Alternately just put the common code in a separate function called common, say, and call it.
myfun <- function (x) UseMethod("myfun")
myfun.numeric <- function(x) {
y <-x+5
common(y)
}
myfun.character <- function(x) {
y <-as.numeric(x)+9
common(y)
}
common <- function(x) {
b<-x^2
c<-b+4
d<-c-3
d
}
myfun("3")
myfun(3)
Suppose I wrote a function that accept another function as an argument:
fct1 <- function(FUN) {
# If FUN is rnorm, then do this.
# If FUN is rbeta, then do this.
}
How should I check whether FUN is rnorm?
I know I can do this to convert the function to a list by as.list() and then coerce it to a string by toString():
toString(as.list(rnorm))
The result is:
", 0, 1, .Call(C_rnorm, n, mean, sd)"
I can then check the content for C_rnorm.
But I think this is not a good solution. I also read somewhere (I cannot remember the source) that coercing a closure to a list and then a string is possible just for backward compatibility, and is not encouraged.
I also thought about body(). For example,
body(rnorm)
The result is:
.Call(C_rnorm, n, mean, sd)
However, then how can I check if C_rnorm is inside the call? I tried to use as.list() and then toString():
toString(as.list(body(rnorm)))
This is the result:
".Call, C_rnorm, n, mean, sd"
However, is this a good practice?
You can use match.call:
fct1 <- function(FUN) {
called <- match.call()$FUN
if(called == "rnorm") {
return("Passed rnorm")
} else {
return("Not rnorm")
}
}
fct1(rnorm)
# [1] "Passed rnorm"
fct1(rlnorm)
# [1] "Not rnorm"