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()).
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 understand the primary difference between dplyr::if_else() and base ifelse(): strict type-checking between true and false outcomes in the former.
However I have noticed another difference, and I'm wondering if it's the intended behaviour or if I am just doing it wrong.
Here's some simple code:
library(dplyr)
choose_number <- function() {
n <- readline("Choose a number between 1 and 4: ")
n <- as.integer(n)
if (between(n, 1, 4)) { return(n) }
else { return(NA_integer_) }
}
# base ifelse() - works perfectly
get_answer <- function(pick = FALSE, n = 2) {
n <- ifelse(pick, choose_number(), as.integer(n))
return(n)
}
# dplyr::if_else() - does not work in the same way
get_answer <- function(pick = FALSE, n = 2) {
n <- if_else(pick, choose_number(), as.integer(n))
return(n)
}
I want get_answer() to call choose_number() only when the pick argument is TRUE. Otherwise it should just return the value of n. It does this perfectly with base ifelse() in the code above, but not with the dplyr version.
The dplyr version does not return an error or warning, however; it still calls choose_number() but ignores the result and just returns the default value of n.
The true option for if_else, choose_number(), will return an integer, as will the false option. So in my mind the type-checking feature of if_else should be satisfied.
the reason is because dplyr::if_else() is more strict than ifelse().
dplyr::if_else() needs to check that both true and false are the same type and class before it is able to execute. since choose_number() is a function, it needs to be resolved first for this class check to take place, so it runs even when your condition is FALSE.
more info here:
https://rdrr.io/cran/dplyr/man/if_else.html
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')
}
}
Consider the following functions
f1 <- function(x) {
# do something
x
}
f2 <- function(x) {
# do something
invisible(x)
}
Suppose I call these two functions separately and save their values.
a <- f1(1)
b <- f2(2)
Is there a way to know if a and b are invisibly returned?
The motivation is that I want to create a function in which if a value is invisibly returned the function also wants to return the value invisibly.
There's withVisible, which lets you do this:
> f3 = function(f, x){
v=withVisible(f(x))
if(v$visible){
return(v$value)
}else{
return(invisible(v$value))
}
}
> f3(f1,1)
[1] 1
> f3(f2,1)
There's no way of doing it once you've got a and b, since identical(a,b) is TRUE. You can only call withVisible on an expression. Unless something lazy or promisy is going on.
A possible alternative to Spacedman's (proper :-) ) solution is to put the following line inside your "outer" function.
if (grepl('invisible', body(inner_function) ) ) return(invisible(data)) else return(data)
Obviously this will fail if you do something creative like naming a variable "pinvisible"
I'm trying to create an enclosing function which will:
process some data,
cat() results of that data,
request user input (ie, via readline() ) based on the results of that cat(),
then return a function where one of the argument defaults of the returned function is the value inputted by readline().
Additionally, I'd like the remaining default values of the arguments of the returned function to be user-interpretable. That is, I don't want the defaults to be variable names of variables hidden in the parent environment (this stipulation precludes simple argument passing). Specifically, I'd like arg() to return actual evaluated numbers, etc.
I've cooked up this solution below, but it feels clunky and awkward. Is there a more elegant way of approaching this?
top <- function(year=1990, n.times=NULL){
if(is.null(n.times)){
###in the real function, data would be processed here
###results would be returned via cat and
###the user is prompted return values that reflect a decision
###made from the processed data
n.times <- as.numeric(readline("how many times?"))
}
out <- function(year, n.times){
###in the real function, this is where most of the work would happen
rep(year, n.times)
}
###this entire section below is clunky.
if( !identical( names(formals()), names(formals(out)) ) ){
stop("internal error: mismatching formals")
}
pass.formals <- setdiff( names(formals()), "n.times")
formals(out)[pass.formals] <- formals()[pass.formals]
formals(out)$n.times <- n.times
out
}
x <- top()
x
It looks generally OK to me; there's only a few things I'd do differently.
Is there any reason that the parameters of top() and out() seem to correspond in some
way? ie, do you need the identical check? Not sure, so I took it out. This seems to do what you
want, and is slightly shorter:
top <- function(year=1990, n.times=NULL){
if (is.null(n.times)) {
n.times <- as.numeric(readline("how many times?"))
}
out <- function(year, n.times) {
rep(year, n.times)
}
out.formals = formals(out)
out.formals['n.times'] = n.times
formals(out) = out.formals
out
}
edit: And if you want to use super R magic, you can write
top <- function(year=1990, n.times=NULL){
if (is.null(n.times)) {
n.times <- as.numeric(readline("how many times?"))
}
`formals<-`(
function() {
rep(year, n.times)
},
value=list(year=alist(x=)$x, n.times=n.times)
)
}
edit: You could also use something like DWin suggested (though I couldn't
get it to work with substitute):
out = function(year, n.times) {
rep(year, n.times)
}
`formals<-`(out, v=`[[<-`(formals(out), 'n.times', n.times))
Or using bquote:
eval(bquote(
function(year, n.times=.(n.times)) {
rep(year, n.times)
}
)[-4L])
You have so many options.