I have three functions and one function is made out of the other two by using useMethod().
logReg <- function(x, ...) UseMethod("logReg")
logRec.numeric <- function(x, y) {
print(x)
}
logReg.formula <- function(formula, data) {
print(formula)
}
My functions are a bit more complex but does not matter for my question. I want logReg to give me additionaly the original function call as output (not the function call of logReg.numeric oder logReg.formula). My first try was:
logReg <- function(x, ...) {
out <- list()
out$call <- match.call()
out
UseMethod("logReg")
}
But it does not work. Can someone give me a hint how to solve my problem?
Here's another way :
logReg <- function(x, ...) {
logReg <- function(x, ...) UseMethod("logReg")
list(logReg(x,...), call=match.call())
}
res <- logReg(1,2)
# [1] 1
res
# [[1]]
# [1] 1
#
# $call
# logReg(x = 1, 2)
#
You can make it work with atttibutes too if you prefer.
Try evaluating it explicitly. Note that this preserves the caller as the parent frame of the method.
logReg <- function(x, ...) {
cl <- mc <- match.call()
cl[[1]] <- as.name("logReg0")
out <- structure(eval.parent(cl), call = mc)
out
}
logReg0 <- function(x, ...) UseMethod("logReg0")
logReg0.numeric <- function(x, ...) print(x)
logReg0.formula <- function(x, ...) print(x)
result <- logReg(c(1,2))
## [1] 1 2
result
## [1] 1 2
## attr(,"call")
## logReg(x = c(1, 2))
Related
I want to change some elements of ... argument in the child function and return it back to the parent function. So the ... is updated within the parent function. I give my idea and a simple example below (not working yet):
parent <- function(x, ...){
... <- child(x, ...) # expect to return and update ...
child_2(x, ...)
}
child <- function(x, ...){
args <- list(...)
args$y = 10 # change value
return(args)
}
child_2 <- function(x, ...){
args <- list(...)
print(args$y = 10) # expect y = 10
}
parent(x=1,y=2)
How can I realize my idea and make it workable?
Use do.call:
parent <- function(x, ...){
args <- child(x, ...) # expect to return and update ...
do.call("child_2", c(x = x, args))
}
child <- function(x, ...){
args <- list(...)
args$y = 10 # change value
return(args)
}
child_2 <- function(x, ...){
args <- list(...)
print(args$y) # expect y = 10
}
parent(x=1,y=2)
## [1] 10
Old
The question was changed. This was the answer to the original question.
Change parent as shown. child is unchanged.
parent <- function(x, ...) {
args <- child(x, ...)
args$y
}
parent(x=1,y=2)
## [1] 10
I'm looking to deal with call evaluations but am out of my depth when it comes to S3 Methods. Basically, I am wondering why a variable that I pass to a function call is not evaluated but rather remains the name of the variable rather than it's value. And all of this depends on whether I name the variable in the function or not.
Let me illustrate with a short example:
I first create a quick function to create a sample class to be used with S3 Methods:
create_myS3 <- function(a, b){
out <- list()
out$a <- a
out$b <- b
class(out) <- "myS3"
return(out)
}
Now the set-up that I am interested in features a number of functions within each other. I first create an S3 method for this myS3 class, let's call it m and we define a specific routine for the myS3 class as well as a default method. Note that the myS3 version calls the default version.
m <- function(x, ...){UseMethod("m")}
m.myS3 <- function(x, estimator = NULL){
y <- list()
y$a <- x$a + 1
y$b <- x$b + 1
out <- m.default(y,
estimator)
return(out)
}
m.default <- function(x, estimator = NULL, ...){
out <- list()
out$call <- sys.call()
out$result <- x$a - x$b
out$aux$estimator <- estimator
return(out)
}
Now that we have defined the functions, we can look at the results function that I'm interested in:
h <- function(x){
out <- list()
out$result_call <- if(is.null(x$call$estimator)){"Success"}else{"Fail"}
out$result_list <- if(is.null(x$aux$estimator)){"Success"}else{"Fail"}
return(out)
}
It's entire purpose is to check whether the estimator element is in the object it is passed to and to give a message based on that.
Ok, now let's put it all together:
g <- function(x){
object <- m(x)
out <- h(object)
return(out)
}
initial <- create_myS3(10,5)
g(initial)
The g() function now calls m() on the input, which was created with the create_myS3 function - so is of class myS3 and is therefore passed to m.myS3 before it is passed to m.default. The resulting object is then passed to h() - in all cases we have not set the estimator argument, which then defaults to NULL and both my check statements in h() return Success.
Now all I do is change one tiny thing: I now modify m.myS3 to call the m.default not just with the order of the input variables but now I also specify the option - in my mind the more robust way. So to clarify, from this m.default(y, estimator) I change it to m.default(x = y, estimator = estimator).
This change then changes my results from h() to Fail for the evaluation if(is.null(x$call$estimator)){"Success"}else{"Fail"} while if(is.null(x$aux$estimator)){"Success"}else{"Fail"} results in Success.
The reason for this is that the call statement evaluates to estimator rather than to its true value NULL.
Is there an easy way to evaluate this call to its true value (I have tried eval or deparse)? Or even better is there are a way to ensure that in m.myS3 the value is always passed rather than the variable?
Here below is the total code for convenience:
create_myS3 <- function(a, b){
out <- list()
out$a <- a
out$b <- b
class(out) <- "myS3"
return(out)
}
m <- function(x, ...){UseMethod("m")}
m.myS3 <- function(x, estimator = NULL){
y <- list()
y$a <- x$a + 1
y$b <- x$b + 1
out <- m.default(y,
estimator)
return(out)
}
m.default <- function(x, estimator = NULL, ...){
out <- list()
out$call <- sys.call()
out$result <- x$a - x$b
out$aux$estimator <- estimator
return(out)
}
h <- function(x){
out <- list()
out$result_call <- if(is.null(x$call$estimator)){"Success"}else{"Fail"}
out$result_list <- if(is.null(x$aux$estimator)){"Success"}else{"Fail"}
return(out)
}
g <- function(x){
object <- m(x)
out <- h(object)
return(out)
}
initial <- create_myS3(10,5)
g(initial)
$result_call
[1] "Success"
$result_list
[1] "Success"
## Changing m.myS3 (only change is to name the option of function m.default)
m.myS3 <- function(x, estimator = NULL){
y <- list()
y$a <- x$a + 1
y$b <- x$b + 1
out <- m.default(x = y,
estimator = estimator)
return(out)
}
g(initial)
$result_call
[1] "Fail"
$result_list
[1] "Success"
I met a problem adding two functions together to a new function in R. For example, fun_1<-function(w)... fun_2<-function(w)... now I need to get a function fun(w)=fun_1(w)+fun_2(w) how could I do it?
Do you mean this ?
fun_1 <- function(x){
x ^ 2
}
fun_2 <- function(x){
x + 1
}
fun_3 <- function(x){
fun_1(x) + fun_2(x)
}
fun_3(1)
returns 3
k <- NA
fun <- function(w){
for (i in 1:100){
k[i] <- (-i/100)^2 + exp(w)
}
sum(k)
}
fun(1)
returns 305.6632
You can use get with envir = parent.frame() and just use paste to specify the function name.
# define functions
for(i in 1:100) assign(paste0('fun',i), function(w) (-i/100)^2+exp(w) )
# sum them
sum.fun <- function(x){
out <- 0
for(i in 1:100){
fun <- get(paste0('fun',i), envir = parent.frame())
out <- out + fun(x)
}
out
}
sum.fun(2)
This question refers to "Programming with dplyr"
I want to slice the ... argument of a function and use each element as an argument for a corresponding function.
foo <- function(...){
<some code>
}
should evaluate for example foo(x, y, z) in this form:
list(bar(~x), bar(~y), bar(~z))
so that x, y, z remain quoted till they get evaluated in bar.
I tried this:
foo <- function(...){
arguments <- quos(...)
out <- map(arguments, ~bar(UQ(.)))
out
}
I have two intentions:
Learn better how tidyeval/rlang works and when to use it.
turn future::futureOf() into a function that get me more then one futures at once.
This approach might be overly complicated, because I don't fully understand the underlying concepts of tidyeval yet.
You don't really need any packages for this. match.call can be used.
foo <- function(..., envir = parent.frame()) {
cl <- match.call()
cl$envir <- NULL
cl[[1L]] <- as.name("bar")
lapply(seq_along(cl)[-1], function(i) eval(cl[c(1L, i)], envir))
}
# test
bar <- function(...) match.call()
foo(x = 1, y = 2, z = 3)
giving:
[[1]]
bar(x = 1)
[[2]]
bar(y = 2)
[[3]]
bar(z = 3)
Another test
bar <- function(...) ..1^2
foo(x = 1, y = 2, z = 3)
giving:
[[1]]
[1] 1
[[2]]
[1] 4
[[3]]
[1] 9
Defining multiple functions in a loop:
par <- 1:2 #parameters for functions
qF <- list() #list I will write the functions into
for(i in 1:2){
qF[[i]] <- function(p){qnorm(p, mean = par[i])}
}
My result:
>qF
[[1]]
function (p)
{
qnorm(p, mean = par[i])
}
[[2]]
function (p)
{
qnorm(p, mean = par[i])
}
The functions are the same! What I WANT my result to be:
>qF
[[1]]
function (p)
{
qnorm(p, mean = par[1])
}
[[2]]
function (p)
{
qnorm(p, mean = par[2])
}
Is there any way to do this?
You can do:
library(functional)
funcs = lapply(1:2, function(u) Curry(qnorm, mean=u))
funcs[[1]](0.77)
#[1] 1.738847
funcs[[2]](0.77)
#[1] 2.738847
Or if you do not appreciate spicy meals:
funcs = lapply(1:2, function(u) function(...) qnorm(..., mean=u))
If you want to create the functions dynamically you need for the par[i] to evaluate each time, otherwise all the par[i] will be evaluated when the functions are called, and i will be the value at the end of the loop.
for(i in 1:2){
qF[[i]] <- local({
mu <- par[i]
function(...) { qnorm(..., mean = mu) }
})
}
You could also substitute the variable into the function body
for(i in 1:2){
qF[[i]] <- eval(substitute(
function(...) qnorm(..., mean = mu)), list(mu=par[i]))
}
And you can see what mu is in each function's environment
sapply(qF, function(f) mget("mu", environment(f)))
# $mu
# [1] 1
#
# $mu
# [1] 2