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. :)
Related
Given a regular R function f, I'd like to be able to create a new function f_debug that acts just like f, but lets me keep track of all the assignments to function-local variables that happened inside it.
For example:
f <- function(x, y) {
z <- x + y
df <- data.frame(z=z)
df
}
# This function doesn't work as intended - would like it to (in the case of `f` above)
# write out a list containing `z` and `df` to an RDS file
capturing <- function(func) {
e <- new.env()
altered <- function(...) {
parent <- parent.frame()
e <- something...(func, environment(), parent, etc., etc.)
result <- func(...)
saveRDS(as.list(e), 'foo.rds')
result
}
environment(func) <- e
altered
}
f_debug <- capturing(f)
I'm not sure whether my knowledge gap to do this is large or small, anyone have a solution?
Solution 1: Steal the function's code
Here's a solution which doesn't return a new function which captures intermediate calculations, but rather calls the given function's code internally. There's some limitations, such as it probably only works with named arguments. Instead of storing the intermediate calculations as an RDS, it attaches them as an attribute.
capturing <- function(fun, ...) {
fun <- match.fun(fun)
code <- body(fun)
parent <- environment(fun)
env <- new.env(parent = parent)
for (val in names(list(...))) {
env[[val]] <- list(...)[[val]]
}
result <- eval(code, envir = env, enclos = parent.frame())
attr(result, "intermediate") <- env
result
}
my_add <- function(x, y) {
z <- x+y
u <- x-y
w <- x*y
x + y
}
intermediates <- function(x) {
attr(x, "intermediate", exact = TRUE)
}
value <- capturing(my_add, x = 1, y = 7)
ls(envir = intermediates(value))
#> [1] "u" "w" "x" "y" "z"
intermediates(value)$x
#> [1] 1
# Created on 2022-02-08 by the reprex package (v2.0.1)
Solution 2: Modify the function's code
One weakness of this solution is that if the chosen function features a call to on.exit(add=FALSE), some additional work needs to be done to modify the function so the internal environment is captured. However, it does work when the function accepts ... arguments.
my_add <- function(x, y) {
z <- x+y
u <- x-y
w <- x*y
x + y
}
insert_capture <- function(code) {
# `<<-` assigns into the global environment if no variable of the given name is found
# while traveling up to the global environment. If you need this assignment to go elsewhere,
# I'd recommend passing in `assign()`. Of course, you could also modify the `on.exit()`
# to use saveRDS.
parse(text=append(deparse(code),
"on.exit(._last_capture <<- environment(), add = TRUE)",
after = 1L))
}
capturing2 <- function(fun) {
fun <- match.fun(fun)
code <- insert_capture(body(fun))
body(fun) <- code
fun
}
my_add2 <- capturing2(my_add)
my_add2(1, 7)
#> [1] 8
ls(envir = ._last_capture)
#> [1] "u" "w" "x" "y" "z"
._last_capture$u
#> [1] -6
Created on 2022-02-08 by the reprex package (v2.0.1)
What you are describing is already implemented in base R with utils::dump.frames, in an even more sophisticated way. It saves the frame (environment) associated with each call in the call stack to an object of class "dump.frames", which you can explore retroactively with utils::debugger as if you had actually run your code under a debugger.
capturing <- function(func, ...) {
cc <- as.call(c(quote(utils::dump.frames), list(...)))
cc <- call("on.exit", cc, add = TRUE)
body(func) <- call("{", cc, body(func))
func
}
capturing injects the call on.exit(utils::dump.frames(...), add = TRUE) into the body of func and returns the modified function.
Here, ... is a list of arguments to dump.frames:
dumpto, a character string giving the name to be used for the "dump.frames" object
to.file, a logical flag indicating whether the "dump.frames" object should be assigned in the global environment or save-ed to paste0(dumpto, ".rda") in the current working directory
include.GlobalEnv, a logical flag indicating whether the global environment should be saved as well
A quick example, which you should try yourself:
tmp <- tempfile()
dir.create(tmp)
cwd <- setwd(tmp)
f <- function(x, y) {
z <- x + y
z + 1
}
g <- capturing(f, dumpto = "zzz", to.file = TRUE)
h <- function(a, b) {
d <- g(a, b)
d + 1
}
h12 <- h(1, 2)
load("zzz.rda")
zzz
## $`h(1, 2)`
## <environment: 0x14c16cb58>
##
## $`#2: g(a, b)`
## <environment: 0x14c16ca40>
##
## attr(,"error.message")
## [1] ""
## attr(,"class")
## [1] "dump.frames"
ls(zzz[[1L]])
## [1] "a" "b"
ls(zzz[[2L]])
## [1] "z" "x" "y"
utils::debugger(zzz)
## Message: Available environments had calls:
## 1: h(1, 2)
## 2: #2: g(a, b)
##
## Enter an environment number, or 0 to exit
## Selection: 2
## Browsing in the environment with call:
## #2: g(a, b)
## Called from: debugger.look(ind)
## Browse[1]> ls()
## [1] "x" "y" "z"
## Browse[1]> x == 1 && y == 2 && z == x + y
## [1] TRUE
## Browse[1]> Q
setwd(cwd)
unlink(tmp, recursive = TRUE)
See ?browser if you are unfamiliar with R's environment browser.
My capturing function has the limitation that on.exit calls in the body of func must also use add = TRUE. If you have written func yourself, then it is not much of a limitation at all, and passing add = TRUE is a good habit anyway.
Ultimately, there is no completely safe way to inject code into functions, but, in an interactive setting, I would say that this level of "unsafety" is fine.
I need to loop through a number of functions, and plot/print the result next to the function name. I learned (this question/answer) that I have to use substitute / eval. This works nicely if each function name per se is enclosed in substitute() (see (A) and (B) below). Is there a way to automatize this, e.g. by using a construction similar to sapply? (C) obviously fails because substitute encloses also the c() clause, but maybe there is a something that I missed to make (D) work? Or any other ideas? Or is there no way?
This is what I tried (small examples, real code has many more functions and plotting stuff).
# A
x <- c(1:10)
my.fun <- substitute(mean) # works
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
# B
for (my.fun in c(substitute(mean), substitute(median))) { # works, but lots of typing for longer function lists
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# C
for (my.fun in substitute(c(mean, median))) { # error: invalid for() loop sequence
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# D
for (my.fun in sapply(c(mean, median), substitute)) { # error: '...' used in an incorrect context
print(paste(deparse(my.fun), ": ", eval(my.fun)(x), sep=""))
}
# E # also not helpful
my.functions <- c(mean, median)
my.fun.2 <- NULL
for (i in 1:2) {
my.fun.2 <- c(my.fun.2, substitute(my.functions[i]))
}
# my.fun.2
# [[1]]
# my.functions[i]
# [[2]]
# my.functions[i]
What about this "one-liner"? :)
> x <- c(1:10)
> f <- function(...)
+ sapply(
+ sapply(
+ as.list(substitute(list(...)))[-1L],
+ deparse),
+ function(fn)
+ get(fn)(x))
> f(mean, median)
mean median
5.5 5.5
In short, you can pass the functions as multiple arguments, then quickly deparse those before actually evaluating the functions one by one. So the above function with a few extra comments:
#' Evaluate multiple functions on some values
#' #param ... any number of function that will take \code{x} as the argument
#' #param x values to be passed to the functions
#' #examples
#' f(mean, median)
#' f(mean, median, sum, x = mtcars$hp)
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function as an anonymous function on "x"
sapply(fns, function(fn) get(fn)(x))
}
Or with do.call instead of this latter anonymous function:
f <- function(..., x = c(1:10)) {
## get provided function names
fns <- sapply(as.list(substitute(list(...)))[-1L], deparse)
## run each function on "x"
sapply(fns, do.call, args = list(x))
}
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!
How do I partially bind/apply arguments to a function in R?
This is how far I got, then I realized that this approach doesn't work...
bind <- function(fun,...)
{
argNames <- names(formals(fun))
bindedArgs <- list(...)
bindedNames <- names(bindedArgs)
function(argNames[!argNames %in% bindedArgs])
{
#TODO
}
}
Thanks!
Here's a version of Curry that both preserves lazy evaluation of function argument, but constructs a function that prints moderately nicely:
Curry <- function(FUN, ...) {
args <- match.call(expand.dots = FALSE)$...
args$... <- as.name("...")
env <- new.env(parent = parent.frame())
if (is.name(FUN)) {
fname <- FUN
} else if (is.character(FUN)) {
fname <- as.name(FUN)
} else if (is.function(FUN)){
fname <- as.name("FUN")
env$FUN <- FUN
} else {
stop("FUN not function or name of function")
}
curry_call <- as.call(c(list(fname), args))
f <- eval(call("function", as.pairlist(alist(... = )), curry_call))
environment(f) <- env
f
}
It basically works by generating an anonymous function in exactly the same way you would if you were constructing the partial binding yourself.
Actually, this seems to work as a work around
bind <- function(fun,...)
{
boundArgs <- list(...)
formals(fun)[names(boundArgs)] <- boundArgs
fun
}
However, ideally I want the bound arguments to disappear completely from the new function so that calls to the new function can happen with name specification, e.g. with add <- function(a,b) a+b I would like (bind(add,a=2))(1) to return 3.
Have you tried looking at roxygen's Curry function?
> library(roxygen)
> Curry
function (FUN, ...)
{
.orig = list(...)
function(...) do.call(FUN, c(.orig, list(...)))
}
<environment: namespace:roxygen>
Example usage:
> aplusb <- function(a,b) {
+ a + 2*b
+ }
> oneplusb <- Curry(aplusb,1)
> oneplusb(2)
[1] 5
Edit:
Curry is concisely defined to accept named or unnamed arguments, but partial application of fun to arguments by way of formal() assignment requires more sophisticated matching to emulate the same functionality. For instance:
> bind <- function(fun,...)
+ {
+ argNames <- names(formals(fun))
+ boundArgs <- list(...)
+ boundNames <- names(boundArgs)
+ if(is.null(boundNames)) {
+ formals(fun)[1:length(boundArgs)] <- boundArgs
+ } else {
+ formals(fun)[match(names(boundArgs),argNames)] <- boundArgs
+ }
+ fun
+ }
> oneplusb <- bind(aplusb,1)
> oneplusb(2)
Error in 2 * b : 'b' is missing
Because the first argument in this function is still a, you need to specify which argument 2 is intended for (b=), or pass it as the second argument.
> oneplusb
function (a = 1, b)
{
a + 2 * b
}
> oneplusb(b=2) ## or oneplusb(,2)
[1] 5
I'm trying to get the names of arguments in the global environment within a function. I know I can use substitute to get the name of named arguments, but I would like to be able to do the same thing with ... arguments. I kinda got it to work for the first element of ... but can't figure out how to do it for the rest of the elements. Any idea how to get this working as intended.
foo <- function(a,...)
{
print(substitute(a))
print(eval(enquote(substitute(...))))
print(sapply(list(...),function(x) eval(enquote(substitute(x)),env=.GlobalEnv)))
}
x <- 1
y <- 2
z <- 3
foo(x,y,z)
x
y
[[1]]
X[[1L]]
[[2]]
X[[2L]]
The canonical idiom here is deparse(substitute(foo)), but the ... needs slightly different processing. Here is a modification that does what you want:
foo <- function(a, ...) {
arg <- deparse(substitute(a))
dots <- substitute(list(...))[-1]
c(arg, sapply(dots, deparse))
}
x <- 1
y <- 2
z <- 3
> foo(x,y,z)
[1] "x" "y" "z"
I would go with
foo <- function(a, ...) {
print( n <- sapply(as.list(substitute(list(...)))[-1L], deparse) )
n
}
Then
foo(x,y,z)
# [1] "y" "z"
Related question was previously on StackOverflow:
How to use R's ellipsis feature when writing your own function? Worth reading.
Second solution, using match.call
foo <- function(a, ...) {
sapply(match.call(expand.dots=TRUE)[-1], deparse)
}