I have a wrapper function, where I need to pass optional arguments to the sub-function specified. But there are so many different possible sub-functions that I can't pre-specify them.
For reference, the sub-functions exist in the environment etc...
Consider:
funInFun<- function (x, method, ...) {
method.out <- function(this.x, FUN, ...) {
FUN <- match.fun(FUN)
c <- FUN(this.x, ...)
return(c)
}
d <- method.out(x, method)
return(d)
}
data<-seq(1,10)
funInFun(data, mean) # Works
data<-c(NA,seq(1,10))
funInFun(data, mean, na.rm=TRUE) # Should remove the NA
funInFun(c(seq(1,10)), quantile, probs=c(.3, .6)) # Shoudl respect the probs option.
You need to pass the ... to method.out. Then it works fine:
funInFun<- function (x, method, ...) {
method.out <- function(this.x, FUN, ...) {
FUN <- match.fun(FUN)
c <- FUN(this.x, ...)
return(c)
}
d <- method.out(x, method, ...) # <<--- PASS `...` HERE
return(d)
}
data<-seq(1,10)
funInFun(data, mean) # Works
# [1] 5.5
data<-c(NA,seq(1,10))
funInFun(data, mean, na.rm=TRUE) # Should remove the NA
# [1] 5.5
funInFun(c(seq(1,10)), quantile, probs=c(.3, .6))
# 30% 60%
# 3.7 6.4
In addition to Thomas' answer to the OP's question you might have to forward an optional argument that is an explicit argument of the wrapper function.
In this case, instead of repeating the default value of the wrapped function in the wrapper definition you can use missing to construct a call with a missing argument.
f <- function(s = "world!") cat("Hello", s)
f()
# Hello world!
g <- function(s = NULL) eval(substitute(
f(s = sub_me),
list(sub_me = if(missing(s)) quote(expr =) else s)))
g()
# Hello world!
g("you!")
# Hello you!
Related
I want to implement an inset method for my class myClass for the internal generic [<- (~ help(Extract)).
This method should run a bunch of tests, before passing on the actual insetting off to [<- via NextMethod().
I understand that:
any method has to include at least the arguments of the generic (mine does, I think)
the NextMethod() call does not usually need any arguments (though supplying them manually doesn't seem to help either).
Here's my reprex:
x <- c(1,2)
class(x) <- c("myClass", "numeric")
`[<-.myClass` <- function(x, i, j, value, foo = TRUE, ...) {
if (foo) {
stop("'foo' must be false!")
}
NextMethod()
}
x[1] <- 3 # this errors out with *expected* error message, so dispatch works
x[1, foo = FALSE] <- 3 # this fails with "incorrect number of subscripts
What seems to be happening is that NextMethod() also passes on foo to the internal generic [<-, which mistakes foo for another index, and, consequently errors out (because, in this case, x has no second dimension to index on).
I also tried supplying the arguments explicitly no NextMethod(), but this also fails (see reprex below the break).
How can I avoid choking up NextMethod() with additional arguments to my method?
(Bonus: Does anyone know good resources for building methods for internal generics? #Hadleys adv-r is a bit short on the matter).
Reprex with explicit arguments:
x <- c(1,2)
class(x) <- c("myClass", "numeric")
`[<-.myClass` <- function(x, i = NULL, j = NULL, value, foo = TRUE, ...) {
if (foo) {
stop("'foo' must be false!")
}
NextMethod(generic = "`[<-`", object = x, i = i, j = j, value = value, ...)
}
x[1] <- 3 # this errors out with expected error message, so dispatch works
x[1, foo = FALSE] <- 3 # this fails with "incorrect number of subscripts
I don't see an easy way around this except to strip the class (which makes a copy of x)
`[<-.myClass` <- function(x, i, value, ..., foo = TRUE) {
if (foo) {
cat("hi!")
x
} else {
class_x <- class(x)
x <- unclass(x)
x[i] <- value
class(x) <- class_x
x
}
}
x <- structure(1:2, class = "myClass")
x[1] <- 3
#> hi!
x[1, foo = FALSE] <- 3
x
#> [1] 3 2
#> attr(,"class")
#> [1] "myClass"
This is not a general approach - it's only needed for [, [<-, etc because they don't use the regular rules for argument matching:
Note that these operations do not match their index arguments in the standard way: argument names are ignored and positional matching only is used. So m[j = 2, i = 1] is equivalent to m[2, 1] and not to m[1, 2].
(from the "Argument matching" section in ?`[`)
That means your x[1, foo = FALSE] is equivalent to x[1, FALSE] and then you get an error message because x is not a matrix.
Approaches that don't work:
Supplying additional arguments to NextMethod(): this can only increase the number of arguments, not decrease it
Unbinding foo with rm(foo): this leads to an error about undefined foo.
Replacing foo with a missing symbol: this leads to an error that foo is not supplied with no default argument.
Here's how I understand it, but I don't know so much about that subject so I hope I don't say too many wrong things.
From ?NextMethod
NextMethod invokes the next method (determined by the class vector,
either of the object supplied to the generic, or of the first argument
to the function containing NextMethod if a method was invoked
directly).
Your class vector is :
x <- c(1,2)
class(x) <- "myClass" # note: you might want class(x) <- c("myClass", class(x))
class(x) # [1] "myClass"
So you have no "next method" here, and [<-.default, doesn't exist.
What would happen if we define it ?
`[<-.default` <- function(x, i, j, value, ...) {print("default"); value}
x[1, foo = FALSE] <- 3
# [1] "default"
x
# [1] 3
If there was a default method with a ... argument it would work fine as the foo argument would go there, but it's not the case so I believe NextMethod just cannot be called as is.
You could do the following to hack around the fact that whatever is called doesn't like to be fed a foo argument:
`[<-.myClass` <- function(x, i, j, value, foo = FALSE, ...) {
if (foo) {
stop("'foo' must be false!")
}
`[<-.myClass` <- function(x, i, j, value, ...) NextMethod()
args <- as.list(match.call())[-1]
args <- args[names(args) %in% c("","x","i","j","value")]
do.call("[<-",args)
}
x[1, foo = FALSE] <- 3
x
# [1] 3 2
# attr(,"class")
# [1] "myClass"
Another example, with a more complex class :
library(data.table)
x <- as.data.table(iris[1:2,1:2])
class(x) <- c("myClass",class(x))
x[1, 2, foo = FALSE] <- 9999
# Sepal.Length Sepal.Width
# 1: 5.1 9999
# 2: 4.9 3
class(x)
# [1] "myClass" "data.table" "data.frame"
This would fail if the next method had other arguments than x, i, j and value, in that case better to be explicit about our additional arguments and run args <- args[! names(args) %in% c("foo","bar")]. Then it might work (as long as arguments are given explicitly as match.call doesn't catch default arguments). I couldn't test this though as I don't know such method for [<-.
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.
If I want to see what expression was passed into a function, I can retrieve it using substitute.
f <- function(x)
{
substitute(x)
}
f(sin(pi))
## sin(pi)
(f returns an object of class call. substitute is usually combined with deparse to turn it into a character vector, but I don't care about that here.)
I want to repeat this with arguments in .... This attempt only returns the first argument:
g <- function(...)
{
substitute(...)
}
g(sin(pi), cos(pi / 2))
## sin(pi)
This attempt throws an error:
h <- function(...)
{
lapply(..., subsitute)
}
h(sin(pi), cos(pi / 2))
## Error in match.fun(FUN) :
## 'cos(pi/2)' is not a function, character or symbol
This attempt throws a different error:
i <- function(...)
{
lapply(list(...), substitute)
}
i(sin(pi), cos(pi / 2))
## Error in lapply(list(...), substitute) :
## '...' used in an incorrect context
How do I retrieve the expressions that I passed into ...?
if you want to keep objetcts of class call:
i <- function(...)
{
l <- match.call()
l <- as.list(l)
l <- l[-1]
l
}
i <- function(...)
{
l <- match.call()
l[[1]] <- as.name("expression")
l
}
i(sin(pi), cos(pi/2))
Or maybe you just need the match.call depending what you want to do after.
hth
Try this one:
substitute_multi <- function(...) {
f <- function(e1, ...) {
if (missing(e1)) return(NULL)
else return(list(substitute(e1), substitute_multi(...)))
}
unlist(f(...))
}
Which gives for example:
substitute_multi(x, g(y), 1+2+3)
## [[1]]
## x
##
## [[2]]
## g(y)
##
## [[3]]
## 1 + 2 + 3
You may also call as.expression on the result to get an expression object.
IMHO, this solution is not as elegant as the other one, but gives some insight on how ... deals with function arguments. :)
I'm astonished that missing seems not working in a function called by lapply. Assume I have the following functions:
.add <- function(x, arg, ...) {
if (missing(arg)) {
arg <- 1
}
print(match.call())
return(x + arg)
}
wrapper <- function(l, arg, ...) {
return(lapply(l, .add, arg=arg, ...))
}
Setting arg explicit works like excepted:
wrapper(list(x=1:10, y=1:10), arg=1)
#FUN(x = X[[1L]], arg = ..1)
#FUN(x = X[[2L]], arg = ..1)
#$x
# [1] 2 3 4 5 6 7 8 9 10 11
#
#$y
# [1] 2 3 4 5 6 7 8 9 10 11
Without arg I would expect the same output but it fails:
wrapper(list(x=1:10, y=1:10))
#FUN(x = X[[1L]], arg = ..1)
# Error in FUN(X[[1L]], ...) : argument "arg" is missing, with no default
missing works in nested wrapper functions where no lapply is used.
Why it seems to have no effect in functions called by lapply?
EDIT: Default arguments also don't work:
.add <- function(x, arg=5, ...) {
if (missing(arg)) {
arg <- 1
}
print(match.call())
return(x + arg)
}
wrapper(list(x=1:10, y=1:10))
#FUN(x = X[[1L]], arg = ..1)
# Error in FUN(X[[1L]], ...) : argument "arg" is missing, with no default
It seems that arg is neither missing nor accessible. What happens here?
(I know that I could circumvent this by setting arg=NULL in wrapper and if (is.null(arg)) in .add or something else. .add is an internal function which determines arg by its own based on the input (e.g. arg=mean(x)) and I want arg in the wrapper to document the argument arg for the user and to allow the user to overwrite the default behavior. And most important: I want to understand why this is not working!)
EDIT2: Finally this behaviour is fixed. It was a bug in R < 3.2.0, see PR#15707.
First, I'll mention that I believe the idiomatic way of doing this is by constructing a call and then evaluating it. See write.csv for an example. I believe this code will do what you want, using that method.
wrapper <- function(X, arg, ...) {
force(X) # optional; if X is missing, the error message will be more informative
Call <- match.call(expand.dots=TRUE)
Call[[1L]] <- as.name("lapply")
Call$FUN <- as.name(".add")
eval.parent(Call)
}
Ok, now here's an attempt to explain the issues you discovered. I stand ready to be corrected as well, but hopefully this will at least help clarify the issues, just like #idfah's answer did.
First, I'll tackle the "defaults" issue, as I think it's more straightforward. This one I think can be made simpler, as in the following two functions, where the second (f2) simply calls the first (f1). What we see is that the default argument in f1 gets overridden by the promise to x in f2, and when that promise is evaluated, it is missing. Moral of this story (I think); defaults must be set again in your calling function, if that variable is included in the call.
f1 <- function(x=1) {print(match.call()); x}
f2 <- function(x) {f1(x=x)}
f1()
## f1()
## [1] 1
f2()
## f1(x = x)
## Error in f1(x = x) : argument "x" is missing, with no default
Now on to the missing in lapply issue. Here I basically have sgibb's code, but have added a message about whether or not arg is considered missing. We have what seems to be a curious contradiction; the message tells us that arg is NOT missing, but when the function tries to access it, we get an error message telling us that arg IS missing.
.add <- function(x, arg) {
print(match.call())
if(missing(arg)) {
message("arg is missing in .add")
x
} else {
message("arg is not missing")
x + arg
}
}
wrapper <- function(l, arg) {lapply(l, .add, arg=arg)}
wrapper(1)
## FUN(x = 1[[1L]], arg = ..1)
## arg is not missing
## Error in FUN(1[[1L]], ...) : argument "arg" is missing, with no default
What I think is happening is the lapply is putting the promise to arg in ..1, so it doesn't look missing, but when it tries to evaluate it, it finds that it is missing. Moral of this story (I think); don't try to propagate missings through lapply.
UPDATE: More precisely, it's something with how dot expansion works. Consider this version of lapply (which doesn't actually work on a list, but otherwise has the same code style); this shows we get the same behavior.
apply3 <- function(X, FUN, ...) {
print(match.call())
FUN(X, ...)
}
wrapper3 <- function(l, arg) {apply3(l, .add, arg=arg)}
wrapper3(1)
## apply3(X = l, FUN = .add, arg = arg)
## FUN(x = X, arg = ..1)
## arg is not missing
## Error in FUN(X, ...) : argument "arg" is missing, with no default
But when we substitute the dots with a variable name, it works as expected.
apply4 <- function(X, FUN, hm) {
print(match.call())
FUN(X, hm)
}
wrapper4 <- function(l, arg) {apply4(l, .add, hm=arg)}
wrapper4(1)
## apply4(X = l, FUN = .add, hm = arg)
## FUN(x = X, arg = hm)
## arg is missing in .add
## [1] 1
And one more example; if I use dots, but do the expansion myself, by calling ..1 directly, it also works! This is curious as the matched call is the same as the version that doesn't work.
apply3b <- function(X, FUN, ...) {
print(match.call())
FUN(X, ..1)
}
wrapper3b <- function(l, arg) {apply3b(l, .add, arg=arg)}
wrapper3b(1)
## apply3b(X = l, FUN = .add, arg = arg)
## FUN(x = X, arg = ..1)
## arg is missing in .add
## [1] 1
There is no missing in your wrapper, so it bombs there. In this case, you don't need it since you are using variadic arguments anyway. Try this:
.add <- function(x, arg, ...) {
if (missing(arg))
arg <- 1
print(match.call())
return(x + arg)
}
wrapper <- function(l, ...)
return(lapply(l, .add, ...))
If the wrapper needs to know arg, then you need an missing there:
.add <- function(x, arg, ...) {
print(match.call())
return(x + arg)
}
wrapper <- function(l, ...) {
if (missing(arg))
arg <- 1
return(lapply(l, .add, arg=arg, ...))
}
I stand corrected
The following example allows the missing to be at the bottom of the call stack, presumably because of lazy evaluation. I am unsure then why your example does not work... curious.
wrapper.c <- function(l, arg)
{
if (missing(arg))
arg <- 1
print("I'm in c")
arg
}
wrapper.b <- function(l, arg)
{
print("I'm in b")
wrapper.c(l, arg)
}
wrapper.a <- function(l, arg)
wrapper.b(l, arg)
> wrapper.a(1)
[1] "I'm in b"
[1] "I'm in c"
[1] 1
In the documentation of sapply and replicate there is a warning regarding using ...
Now, I can accept it as such, but would like to understand what is behind it. So I've created this little contrived example:
innerfunction<-function(x, extrapar1=0, extrapar2=extrapar1)
{
cat("x:", x, ", xp1:", extrapar1, ", xp2:", extrapar2, "\n")
}
middlefunction<-function(x,...)
{
innerfunction(x,...)
}
outerfunction<-function(x, ...)
{
cat("Run middle function:\n")
replicate(2, middlefunction(x,...))
cat("Run inner function:\n")
replicate(2, innerfunction(x,...))
}
outerfunction(1,2,3)
outerfunction(1,extrapar1=2,3)
outerfunction(1,extrapar1=2,extrapar2=3)
Perhaps I've done something obvious horribly wrong, but I find the result of this rather upsetting. So can anyone explain to me why, in all of the above calls to outerfunction, I get this output:
Run middle function:
x: 1 , xp1: 0 , xp2: 0
x: 1 , xp1: 0 , xp2: 0
Run inner function:
x: 1 , xp1: 0 , xp2: 0
x: 1 , xp1: 0 , xp2: 0
Like I said: the docs seem to warn for this, but I do not see why this is so.
?replicate, in the Examples section, tells us explicitly that what you are trying to do does not and will not work. In the Note section of ?replicate we have:
If ‘expr’ is a function call, be aware of assumptions about where
it is evaluated, and in particular what ‘...’ might refer to. You
can pass additional named arguments to a function call as
additional named arguments to ‘replicate’: see ‘Examples’.
And if we look at Examples, we see:
## use of replicate() with parameters:
foo <- function(x=1, y=2) c(x,y)
# does not work: bar <- function(n, ...) replicate(n, foo(...))
bar <- function(n, x) replicate(n, foo(x=x))
bar(5, x=3)
My reading of the docs is that they do far more than warn you about using ... in replicate() calls; they explicitly document that it does not work. Much of the discussion in that help file relates to the ... argument of the other functions, not necessarily to replicate().
If you look at the code for replicate:
> replicate
function (n, expr, simplify = TRUE)
sapply(integer(n), eval.parent(substitute(function(...) expr)),
simplify = simplify)
<environment: namespace:base>
You see that the function is evaluated in the parent frame, where the ... from your calling function no longer exists.
There actually is a way to do this:
# Simple function:
ff <- function(a,b) print(a+b)
# This will NOT work:
testf <- function(...) {
replicate(expr = ff(...), n = 5)
}
testf(45,56) # argument "b" is missing, with no default
# This will:
testf <- function(...) {
args <- as.list(substitute(list(...)))[-1L]
replicate(expr = do.call(ff, args), n = 5)
}
testf(45,56) # 101
An alternative way to do that:
g <- function(x, y) x + y
f <- function(a = 1, ...) {
arg_list <- list(...)
replicate(n = 3, expr = do.call(g, args = arg_list))
}
f(x = 1, y = 2)