Tried this code via source()
f1 <- function(x, ...){
print(y)
}
f1(x = 1, y = 2)
or this code via source()
f1 <- function(x, ...){
y <- 2
f2(x, y = y, ...)
}
f2 <- function(x, ...){
print(y)
}
f1(x = 1)
Got this Error
Error in print(y) : object 'y' not found
I guess the '...' argument takes from the global environment?
you should call y in your function as correct like this
f1 <- function(x, ...){
l <- list(...)
if(!is.null(l$y)) print(l$y)
}
f1(x = 1, y=2)
Related
Suppose fun is a function with 3 arguments (x, y, z) and y or z needs to be specified, but not both.
fun <- function(x, y, z) {
if (missing(y)) {
x^2
} else {
x^5
}
}
Now assume this function gets call within another function as:
fun.v1 <- function(x, y, z) {
sapply(x, fun, y, z)
}
> fun.v1(1:5, y = 4)
[1] 1 32 243 1024 3125
> fun.v1(1:5, z = 4)
[1] 1 4 9 16 25
Rather than using sapply, now I want to implement a parallel backend:
require(parallel)
fun.v2 <- function(x, y, z) {
cl <- makeCluster(2)
bf <- parSapplyLB(cl = cl, X = x, fun, y, z)
stopCluster(cl = cl)
}
fun.v2(1:5, y = 4)
fun.v2(1:5, z = 4)
This code gives an error. Is there a way to fix this?
Update: Below code works as intended. But is there a neater way of doing this?
fun <- function(x, y, z) {
if (is.null(y)) {
x^2
} else {
x^5
}
}
fun.v2 <- function(x, y, z) {
cl <- makeCluster(2)
tmp1 <- if(missing(y))
NULL
else y
tmp2 <- if(missing(z))
NULL
else z
bf <- parSapplyLB(cl = cl, X = x, fun, y = tmp1, z = tmp2)
stopCluster(cl = cl)
return(bf)
}
> fun.v2(1:5, y = 4)
[1] 1 32 243 1024 3125
> fun.v2(1:5, z = 4)
[1] 1 4 9 16 25
It seems that y and z are both non-optional arguments. You can make them optional as follows:
fun.v2 <- function(x, y = NULL, z = NULL) {
cl <- makeCluster(2)
bf <- parSapplyLB(cl = cl, X = x, fun, y, z)
stopCluster(cl = cl)
}
This no longer throws an error.
i have defined a method for printing a vector with the class test:
print.test <- function(x, ...) {
x <- formatC(
as.numeric(x),
format = "f",
big.mark = ".",
decimal.mark = ",",
digits = 1
)
x[x == "NA"] <- "-"
x[x == "NaN"] <- "-"
print.default(x)
}
which works fine for the following
a <- c(1000.11, 2000.22, 3000.33)
class(a) <- c("test", class(a))
print(a)
[1] "1.000,11" "2.000,22" "3.000,33"
this also works:
round(a)
[1] "1.000,0" "2.000,0" "3.000,0"
this does not:
median(a)
[1] 2000.22
class(median(a))
[1] "numeric"
now my question is: do i need to write a custom method for this class to use median e.g. and if so what would it look like or is there another way (as i simply would like this class to print the data in a certain format)?
The problem is that median.default returns an object of class numeric therefore autoprinting of the returned object does not call your custom print method.
The following will do so.
median.test <- function(x, na.rm = FALSE, ...){
y <- NextMethod(x, na.rm = na.rm, ...)
class(y) <- c("test", class(y))
y
}
median(a)
#[1] "2.000,2"
As for the handling of NA values, I will first define another method for a base R function. It is not strictly needed but save some code lines if objects of class test are used frequently.
c.test <- function(x, ...){
y <- NextMethod(x, ...)
class(y) <- c("test", class(y))
y
}
b <- c(a, NA)
class(b)
#[1] "test" "numeric"
median(b)
#[1] "-"
median(b, na.rm = TRUE)
#[1] "2.000,2"
EDIT.
The following defines a generic function wMedian, a default method and a method for objects of class "currency", as requested by the OP in a comment.
Note that there must be a method print.currency, which I don't redefine since it's exactly the same as print.test above. As for the other methods, I have made them simpler with the help of a new function, as.currency.
median.currency <- function(x, na.rm = FALSE, ...){
y <- NextMethod(x, na.rm = na.rm, ...)
as.currency(y)
}
c.currency <- function(x, ...){
y <- NextMethod(x, ...)
as.currency(y)
}
as.currency <- function(x){
class(x) <- c("currency", class(x))
x
}
wMedian <- function(x, ...) UseMethod("wMedian")
wMedian.default <- function(x, ...){
matrixStats::weightedMedian(x, ...)
}
wMedian.currency <- function(x, w = NULL, idxs = NULL, na.rm = FALSE, interpolate = is.null(ties), ties = NULL, ...) {
y <- NextMethod(x, w = w, idxs = idxs, na.rm = na.rm, interpolate = interpolate, ties = ties, ... )
as.currency(y)
}
set.seed(1)
x <- rnorm(10)
wMedian(x, w = (1:10)/10)
#[1] 0.4084684
wMedian(as.currency(x), w = (1:10)/10)
#[1] "0,4"
In line with my reading of Hadley's advice on building S3 objects I am using a helper function, a constructor function, and a validator function. A simple reproducible example:
test_object <- function(x, y, z) {
new_test_object(x, y, z)
}
new_test_object <- function(x, y, z) {
structure(list(x = x,
y = y,
z = z,
x_name = deparse(substitute(x))),
class = "test_object")
}
validate_test_object <- function(test_object) {
# Anything goes
test_object
}
I would like the resulting object to include a value with the original name that the item passed in had ($x_name in the above example). The deparse(substitute(...)) trick works if I call the constructor directly:
alpha = "a"
test_constructor <- new_test_object(x = alpha, y = "b", z = "c")
test_constructor$x_name
# [1] "alpha"
But not if I use the helper function:
test_helper <- test_object(x = alpha, y = "b", z = "c")
test_helper$x_name
# [1] "x"
I would like test_helper$x_name to also return [1] "alpha".
Short of doing the deparse(substitute(...)) step at the helper stage, is there any way of the constructor function (new_test_object()) accessing the 'original' name of the object x if it has come via the helper? Or to ensure that its name passes through with it as the helper function passes it to the constructor?
What's really the purpose here? If you are just using one function as a wrapper to another, then there are better ways of preserving arguments. For example
test_object <- function(x, y, z) {
call <- match.call()
call[[1]] <- quote(new_test_object)
eval(call)
}
But in general relying on deparse() to get information from names of variables isn't a very reliable method. It would be better to have such pieces of information be proper parameters that you can set if you like. This makes your functions much more flexible.
test_object <- function(x, y, z, xname=deparse(substitute(x))) {
new_test_object(x, y, z, xname=xname)
}
new_test_object <- function(x, y, z, xname=deparse(substitute(x))) {
structure(list(x = x,
y = y,
z = z,
x_name = xname),
class = "test_object")
}
Here is a not beautifull fix: you add ... argument to pass the name when you are calling it from another function
test_object <- function(x, y, z) {
x_name = deparse(substitute(x))
new_test_object(x, y, z, x_name = x_name)
}
new_test_object <- function(x, y, z, ...) {
args <- list(...)
if(is.null(args[["x_name"]])){
structure(list(x = x,
y = y,
z = z,
x_name = deparse(substitute(x))),
class = "test_object")
}
else{
structure(list(x = x,
y = y,
z = z,
x_name = args[["x_name"]]),
class = "test_object")
}
}
And here is the result:
test_helper <- test_object(x = alpha, y = "b", z = "c")
test_helper$x_name
# [1] "alpha"
I am trying to write a custom curve function where the ... would be passed to the function rather than the plot: I would like to be able to use say:
curve2(dnorm, mean=2, sd=3)
I run into a problem with handling the ... in a call environment. Starting from a simplified prototype of curve:
minicurve <- function (expr, from = 0, to = 1, ...)
{
sexpr <- substitute(expr)
expr <- call(as.character(sexpr), as.name("x"))
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
# This gives the same behaviour as `curve`:
minicurve(dnorm)
Now I would like to pass the ... into the call (instead of passing into plot). Usually, this is very easy, one just need to pass the ... into the function. However, the call function behaves differently, and I am not sure how I should handle it. I can just use:
dot1 <- substitute(...)
expr <- call(as.character(sexpr), as.name(xname), dot1)
This will work, however it will pass only the first argument. I need hence to use someting like:
dots <- substitute(list(...))
expr <- call(as.character(sexpr), as.name(xname), dots)
But this doesn't work:
minicurve2 <- function (expr, from = 0, to = 1, ...)
{
sexpr <- substitute(expr)
dots <- substitute(list(...))
expr <- call(as.character(sexpr), as.name(xname), dots)
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
So how do I pass a list of ... into the call function? Thanks!
How about this
minicurve <- function (expr, from = 0, to = 1, ...) {
sexpr <- substitute(expr)
expr <- call(as.character(sexpr), as.name("x"))
ll <- list(x = seq(from=from, to=to, length.out=100))
names(ll) <- "x"
dots <- substitute(...())
expr <- as.call(c(as.list(expr), dots))
y <- eval(expr, envir = ll, enclos = parent.frame())
plot(x = ll$x, y = y, type="l")
}
Here we capture the ... as a list via the substitute(...()) syntax. Then we convert the call to a list, append in the parameters, and turn it back into a call.
We test with
minicurve(dnorm, mean=2, sd=3)
minicurve(dnorm, mean=.5, sd=5)
I need to intercept the value of an optional xlim in a function so that I can change the units of it before plotting. The following function confirms that xlim was passed, but I can't access the value.
foo <- function(x, y, ...) {
if ("xlim" %in% names(list(...))) {
print(xlim) # not found/can't use value!
}
# modify xlim and pass to plotting functions
return()
}
But foo(x = 1:5, y = 1:5, xlim = c(2,4)) gives:
Error in print(xlim) : object 'xlim' not found
What trick do I need use the value? Seems like it should just work, but I see from looking around on SO that the dots can be vexing. I've played a bit with exists, deparse etc but I don't really 'get' the proper use of those functions.
EDIT: so here is the final snippet which was the leanest way to access the value:
dots <- list(...)
if (any(names(dots) == "xlim")) {
xlim <- dots$xlim
print(xlim)
}
This is because xlim is actually a list element, and is not (yet) an actual object in the function's environment. You could do
foo <- function(x, y, ...) {
m <- match.call(expand.dots = FALSE)$...
if(any(names(m) == "xlim")) m[["xlim"]]
else stop("no xlim value")
}
foo(x = 1:5, y = 1:5, xlim = c(2,4))
# c(2, 4)
foo(x = 1:5, y = 1:5, ylim = c(2,4))
# Error in foo(x = 1:5, y = 1:5, ylim = c(2, 4)) : no xlim value
You can see what match.call is doing if we examine the function as
f <- function(x, y, ...) {
match.call(expand.dots = FALSE)$...
}
It is a list of all the entered dot arguments with their respective expressions, so there are many different ways to get the values, the above is just one way.
f(x = 1:5, y = 1:5, xlim = c(2,4))
# $xlim
# c(2, 4)
Alternatively, you could do
g <- function(x, y, ...) {
dots <- list(...)
any(names(dots) == "xlim")
}
g(x = 1:5, y = 1:5, xlim = c(2,4))
# [1] TRUE
Also keep in mind that match.call keeps the argument as an unevaluated call, while list(...) evaluates the argument. This might be important for you passing the argument to other functions.