Consider the function
f <- function(x, X) mean(c(x,X))
How can I automatically (by manipulation of f()) change the signature of f() such that it can be used with lapply(), i.e., without returning the following obvious error?
lapply(X=list(1), FUN=f, X=1)
Error in lapply(X = list(1), FUN = f, X = 1) :
formal argument "X" matched by multiple actual arguments
The approach I used so far is to remove all arguments from f(), assign them into an environment, and evaluatef() in that environment.
integrateArgs <- function (f, args)
{
form <- formals(f)
if (!is.null(form))
for (i in seq_along(form)) assign(names(form)[i], form[[i]])
if (!is.null(args))
for (i in seq_along(args)) assign(names(args)[i], args[[i]])
ff <- function() {
}
parent.env(environment(ff)) <- parent.env(environment(f))
body(ff) <- body(f)
if (any(names(form) == "..."))
formals(ff) <- form[names(form) == "..."]
ff
}
fnew <- integrateArgs(f, list(x=1, X=4))
lapply(list(fnew), function(x) x())
[[1]]
[1] 2.5
However, that approach leads to the following error if f() is a function from another R package that calls compiled code.
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
Error in x() (from #1) : object 'C_dnorm' not found
Are there better solutions?
As suggested in a comment by MrFlick, one solution is
library(purrr)
integrateArgs <- function(f, args){
do.call(partial, c(list(f), args))
}
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
[[1]]
[1] 0.004431848
The following similar approach does not require the package purrr:
integrateArgs <- function(f, args){
do.call(function(f, ...) {
eval(call("function", NULL,
substitute(f(...))), envir = environment(f))},
c(f = list(f), args))
}
fnew2 <- integrateArgs(dnorm, list(x=1, mean=4))
lapply(list(fnew2), function(x) x())
[[1]]
[1] 0.004431848
A similar approach is now used in optimParallel version 0.7-4 to execute functions in parallel using parallel::parLapply(): https://cran.r-project.org/package=optimParallel
Related
This is my function:
f <- function(a, b, ...){
c(as.list(environment()), list(...))
}
If I call f(a = 2) no error will be raised, although b is missing. I would like to get an error in this case:
Error in f(a = 2) : argument "b" is missing, with no default
What piece of dynamic and efficient code I must add such that this error be raised? I was thinking something in line of the following: force(as.symbol(names(formals()))).
Note: In case you wonder why I need this kind of function: It is a way to standardize the kinds of lists. Such a list must have a and b, and possibly other keys. I could play with objects too...
Solutions: See Carl's answer or comments below.
f <- function(a, b, ...){
sapply(ls(environment()), get, envir = environment(), inherits = FALSE)
c(as.list(environment()), list(...))
}
Or
f <- function(a, b, ...){
stopifnot(all(setdiff(names(formals()), '...') %in% names(as.list(match.call()[-1]))))
c(as.list(environment()), list(...))
}
An idea... first check for all arguments that exist in the any function anonymously... meaning regardless of the functions, get the arguments into a list with no preset requirements:
#' A function to grab all arguments of any calling environment.. ie.. a function
#'
#'
#' \code{grab.args}
#'
grab.args <- function() {
envir <- parent.frame()
func <- sys.function(-1)
call <- sys.call(-1)
dots <- match.call(func, call, expand.dots=FALSE)$...
c(as.list(envir), dots)
}
Then, in whatever function you use it for.. store the initial arguments on a list does_have, then find all the arguments that are pre-defined in the environment with should_have, loop through the list to match names and find if any are missing values... if any are... create the error with the names that are missing, if not... do your thing...
#' As an example
#'
f <- function(a, b, ...){
does_have <- grab.args()
should_have <- ls(envir = environment())
check_all <- sapply(should_have, function(i){
!nchar(does_have[[i]])
})
if(any(mapply(isTRUE, check_all))){
need_these <- paste(names(which(mapply(isTRUE,check_all))), collapse = " and ")
cat(sprintf('Values needed for %s', need_these))
}else {
does_have
}
}
Outputs for cause....
> f(mine = "yours", a = 3)
Values needed for b
> f(b = 12)
Values needed for a
> f(hey = "you")
Values needed for a and b
Edit to throw an actual error...
f <- function(a,b,...){
Filter(missing, sapply(ls(environment()), get, environment()))
}
> f(a = 2, wtf = "lol")
Error in FUN(X[[i]], ...) : argument "b" is missing, with no default
I want to avoid using parse() in a function definition that contains a polynomial().
My polynomial is this:
library(polynom)
polynomial(c(1, 2))
# 1 + 2*x
I want to create a function which uses this polynomial expression as in:
my.function <- function(x) magic(polynomial(c(1, 2)))
where for magic(), I have tried various combinations of expression(), formula(), eval(), as.character(), etc... but nothing seems to work.
My only working solution is using eval(parse()):
eval(parse(text = paste0('poly_function <- function(x) ', polynomial(c(1, 2)))))
poly_function(x = 10)
# 21
Is there a better way to do want I want? Can I avoid the eval(parse())?
Like you, I though that the polynomial function was returning an R expression, but we were both wrong. Reading the help Index for package:polynom would have helped us both:
str(pol)
#Class 'polynomial' num [1:2] 1 2
help(pac=polynom)
So user20650 is correct and:
> poly_function <- as.function(pol)
> poly_function(10)
[1] 21
So this was how the authors (Venables, Hornick, Maechler) do it:
> getAnywhere(as.function.polynomial)
A single object matching ‘as.function.polynomial’ was found
It was found in the following places
registered S3 method for as.function from namespace polynom
namespace:polynom
with value
function (x, ...)
{
a <- rev(coef(x))
w <- as.name("w")
v <- as.name("x")
ex <- call("{", call("<-", w, 0))
for (i in seq_along(a)) {
ex[[i + 2]] <- call("<-", w, call("+", a[1], call("*",
v, w)))
a <- a[-1]
}
ex[[length(ex) + 1]] <- w
f <- function(x) NULL
body(f) <- ex
f
}
<environment: namespace:polynom>
Since you mention in your comments that getAnywhere was new then it also might be the case that you could gain by reviewing the "run up" to using it. If you type a function name at the console prompt, you get the code, in this case:
> as.function
function (x, ...)
UseMethod("as.function")
<bytecode: 0x7f978bff5fc8>
<environment: namespace:base>
Which is rather unhelpful until you follow it up with:
> methods(as.function)
[1] as.function.default as.function.polynomial*
see '?methods' for accessing help and source code
The asterisk at the end of the polynomial version tells you that the code is not "exported", i.e. available at the console just by typing. So you need to pry it out of a loaded namespace with getAnywhere.
It seems like you could easily write your own function too
poly_function = function(x, p){
sum(sapply(1:length(p), function(i) p[i]*x^(i-1)))
}
# As 42- mentioned in comment to this answer,
# it appears that p can be either a vector or a polynomial
pol = polynomial(c(1, 2))
poly_function(x = 10, p = pol)
#[1] 21
#OR
poly_function(x = 10, p = c(1,2))
#[1] 21
I have a drawing function f that should not return any output.
f <- function(a=0) invisible(NULL)
f(10)
After vectorizing f, it does return NULL.
f_vec <- Vectorize(f)
f_vec(10)
[[1]]
NULL
How can I prevent this, i.e. make the output invisible here as well.
I could of course use a wrapper to suppress it.
f_wrapper <- function(a=0) {
dummy <- f_vec(a)
}
f_wrapper(10)
Is there a way to avoid the wrapper and get what I want straight away?
Yeah there is. This new version of Vectorize will do it:
Vectorize_2 <- function (FUN, vectorize.args = arg.names, SIMPLIFY = TRUE, USE.NAMES = TRUE) {
arg.names <- as.list(formals(FUN))
arg.names[["..."]] <- NULL
arg.names <- names(arg.names)
vectorize.args <- as.character(vectorize.args)
if (!length(vectorize.args))
return(FUN)
if (!all(vectorize.args %in% arg.names))
stop("must specify names of formal arguments for 'vectorize'")
FUNV <- function() {
args <- lapply(as.list(match.call())[-1L], eval, parent.frame())
names <- if (is.null(names(args)))
character(length(args))
else names(args)
dovec <- names %in% vectorize.args
invisible(do.call("mapply", c(FUN = FUN, args[dovec], MoreArgs = list(args[!dovec]),
SIMPLIFY = SIMPLIFY, USE.NAMES = USE.NAMES)))
}
formals(FUNV) <- formals(FUN)
FUNV
}
But, how did I know to do this? Did I spend 20 minutes writing a brand new version of Vectorize? NOPE! I just ran dput(Vectorize) to see the R code behind Vectorize and added the invisible where necessary! You can do this with all R functions. You don't even need the dput! Just run Vectorize!
I'm trying to write some S3 methods, and I'd like them to share common error handling code. This seemed like the obvious way to me:
myMethod <- function(x) {
tryCatch(UseMethod("myMethod", x), error=function(e) paste("Caught:", e))
}
myMethod.default <- function(x) print("Default.")
But it doesn't work, since UseMethod doesn't like being wrapped in tryCatch:
myMethod(0)
[1] "Caught: Error in UseMethod(\"myMethod\", x): 'UseMethod' used in an inappropriate fashion\n"
Does anyone have any advice on where to go from here?
Just wrap it.
myMethod <- function(x) {
fn <- function() UseMethod("myMethod", x)
tryCatch(fn(), error = function(e) paste("Caught:", e))
}
myMethod.default <- function(x) print("Default.")
myMethod(structure('1', class='default'))
# [1] "Default."
I am facing a strange problem about do.call and curve:
func1 <- function (m, n) {
charac <- paste ("func2 <- function(x)", m, "*x^", n, sep = "")
eval(parse(text = charac))
return(func2)
}
func3 <- function (m, n) {
my.func <- func1 (m, n)
do.call("curve",list(expr = substitute(my.func)))
}
func1 constructs func2 and func3 plots the constructed func2.
But when I run func3, following error would be displayed:
> func3 (3, 6)
Error in curve(expr = function (x) :
'expr' must be a function, or a call or an expression containing 'x'
However, while I run func1 and plot the output manually (without applying func3), func2 would be plotted:
my.func <- func1 (3, 6)
do.call("curve",list(expr = substitute(my.func)))
What happened here leads me to a confusion and I do not know why do.call can not plot func2 inside func3 local environment.
Thank you
You are making this overcomplicated - you don't need to do anything special when creating f2:
f1 <- function (m, n) {
function(x) m * x ^ n
}
f3 <- function (m, n) {
f2 <- f1(m, n)
curve(f2)
}
f3(3, 6)
This could, of course, be made more concise by eliminating f1:
f4 <- function (m, n) {
f2 <- function(x) m * x ^ n
curve(f2)
}
f4(3, 6)
You can find more information about R's scoping rules (which makes this work) at https://github.com/hadley/devtools/wiki/Functions
It is not a problem of do.call, but substitute which evaluate by default in the global environment.
So you need to tell it in which environment substitution must occur. Here obviously in the local envir of func3.
This should work:
do.call("curve",list(expr = substitute(my.func,
env = parent.frame())))
Edit thanks Dwin
As said in the comment substitute env Defaults to the current evaluation environment. So Why the code below works? The answer in the help of substitute
formal argument to a function or explicitly created using
delayedAssign(), the expression slot of the promise replaces the
symbol. If it is an ordinary variable, its value is substituted,
unless env is .GlobalEnv in which case the symbol is left unchanged.
env = parent.frame(n=1) is equivalent to .GlobalEnv, that why the symbol (my.func) is left unchanged. So the correct answer would be :
do.call("curve",list(expr = substitute(my.func,
env = .GlobalEnv)))
To test , I open new R session :
func1 <- function (m, n) {
charac <- paste ("func2 <- function(x)", m, "*x^", n, sep = "")
eval(parse(text = charac))
return(func2)
}
func3 <- function (m, n) {
my.func <- func1 (m, n)
do.call("curve",list(expr = substitute(my.func,env = .GlobalEnv)))
}
Than I call
func3(2,6)
This works:
func3 <- function (m, n) {
my.func <- func1 (m, n); print(str(my.func))
do.call(curve, list(expr=bquote( my.func) ) )
}
You just need to remove line:
my.func <- func1 (m, n)
from func3.