I would like to create a function (similar to ggplot or lm) that prints a value - other than what's being returned - only if it's not called by other functions (except print).
What I've tried:
my_fun <- function(x){
print(0)
invisible(x + 1)
}
my_fun(1) #> 0 works as desired
print(my_fun(1)) #> 0 2 should print only 0
val <- my_fun(1) #> 0 shouldn't print anything
There's probably multiple ways to achieve this, but essentially you need to define a custom print method for the output of my_fun. In gglot2 the function returns a data structure but the print method for that data structure is what actually renders it visually.
Here's an example of using an S3 class
my_fun <- function(x){
invisible(structure(x + 1, class = "myClass"))
}
print.myClass <- function(x, ...) {
print(0)
}
my_fun(1)
print(my_fun(1))
#> [1] 0
val <- my_fun(1)
I would like to have a function accept arguments in the usual R way, most of which will have defaults. But I would also like it to accept a list of named arguments corresponding to some or some or all of the formals. Finally, I would like arguments supplied to the function directly, and not through the list, to override the list arguments where they conflict.
I could do this with a bunch of nested if-statements. But I have a feeling there is some elegant, concise, R-ish programming-on-the-language solution -- probably multiple such solutions -- and I would like to learn to use them. To show the kind of solution I am looking for:
> arg_lst <- list(x=0, y=1)
> fn <- function(a_list = NULL, x=2, y=3, z=5, ...){
<missing code>
print(c(x, y, z))
}
> fn(a_list = arg_list, y=7)
Desired output:
x y z
0 7 5
I like a lot about #jdobres's approach, but I don't like the use of assign and the potential scoping breaks.
I also don't like the premise, that a function should be written in a special way for this to work. Wouldn't it be better to write a wrapper, much like do.call, to work this way with any function? Here is that approach:
Edit: solution based off of purrr::invoke
Thinking a bit more about this, purrr::invoke almost get's there - but it will result in an error if a list argument is also passed to .... But we can make slight modifications to the code and get a working version more concisely. This version seems more robust.
library(purrr)
h_invoke = function (.f, .x = NULL, ..., .env = NULL) {
.env <- .env %||% parent.frame()
args <- c(list(...), as.list(.x)) # switch order so ... is first
args = args[!duplicated(names(args))] # remove duplicates
do.call(.f, args, envir = .env)
}
h_invoke(fn, arg_list, y = 7)
# [1] 0 7 5
Original version borrowing heavily from jdobres's code:
hierarchical_do_call = function(f, a_list = NULL, ...){
formal_args = formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('f', 'a_list', '...')] = NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args[c('f', 'a_list')] = NULL # ...but remove the argument list and the function
a_list[names(supplied_args)] = supplied_args
do.call(what = f, args = a_list)
}
fn = function(x=2, y=3, z=5) {
print(c(x, y, z))
}
arg_list <- list(x=0, y=1)
hierarchical_do_call(f = fn, a_list = arg_list, y=7)
# x y z
# 0 7 5
I'm not sure how "elegant" this is, but here's my best attempt to satisfy the OP's requirements. The if/else logic is actually pretty straightforward (no nesting needed, per se). The real work is in collecting and sanitizing the three different input types (formal defaults, the list object, and any supplied arguments).
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
formal_args <- formals() # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call())[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]])
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]])
}
}
print(c(x, y, z))
}
arg_lst <- list(x = 0, y = 1)
fn(a_list = arg_lst, y=7)
[1] 0 7 5
With a little more digging into R's meta-programming functions, it's actually possible to pack this hierarchical assignment into its own function, which is designed to operate on the function environment that called it. This makes it easier to reuse this functionality, but it definitely breaks scope and should be considered dangerous.
The "hierarchical assignment" function, mostly the same as before:
hierarchical_assign <- function(a_list) {
formal_args <- formals(sys.function(-1)) # get the function's defined inputs and defaults
formal_args[names(formal_args) %in% c('a_list', '...')] <- NULL # remove these two from formals
supplied_args <- as.list(match.call(sys.function(-1), sys.call(-1)))[-1] # get the supplied arguments
supplied_args['a_list'] <- NULL # ...but remove the argument list
# for each uniquely named item among the 3 inputs (argument list, defaults, and supplied args):
for (i in unique(c(names(a_list), names(formal_args), names(supplied_args)))) {
if (!is.null(supplied_args[[i]])) {
assign(i, supplied_args[[i]], envir = parent.frame())
} else if (!is.null(a_list[[i]])) {
assign(i, a_list[[i]], envir = parent.frame())
}
}
}
And the usage. Note that the the calling function must have an argument named a_list, and it must be passed to hierarchical_assign.
fn <- function(a_list = NULL, x = 2, y = 3, z = 5, ...) {
hierarchical_assign(a_list)
print(c(x, y, z))
}
[1] 0 7 5
I think do.call() does exactly what you want. It accepts a function and a list as arguments, the list being arguments for the functions. I think you will need a wrapper function to create this behavior of "overwriting defaults"
I am writing a program in which I need a function to call a function that was determined in the period beforehand, which may again call the function that was determined before itself and so on. However, I am finding myself inable to implement this in R.
Here is a minimal example of what I am trying to do:
functions <- list()
functions[[1]] <- function(x){
x
}
for (i in 2:10)
{
functions[[i]] <- function(x){
functions[[i-1]](x) + x
}
}
So after running this script, what I would want to happen is that when I call functions[[10]](1) is that R determines the value the function would have had in period 9, for which it needs the value of the function in period 8 and so on and adds the input to it. (So obviously, the output should be 10).
The problem is that when I do this, the function calls itself infinitely. The list looks like this:
[[1]]
function (x)
{
x
}
[[2]]
function (x)
{
functions[[i - 1]](x) + x
}
[[3]]
function (x)
{
functions[[i - 1]](x) + x
}
(...)
So when I call functions[[10]](x), it evaluates to functions[[9]](x) + x, but functions[[9]] then keeps calling itself over and over again.
Is there anything I can do so that I force R to write the value of i - 1 into each element of the list, such that it would look as follows?
[[1]]
function (x)
{
x
}
[[2]]
function (x)
{
functions[[1]](x) + x
}
[[3]]
function (x)
{
functions[[2]](x) + x
}
(...)
Or is there any other way I could do what I am trying to do here?
(Obviously, in the above given example, I could just sum, but in the application I am trying to simulate here, this is not possible and I can't think of another way to do it other than having each function call the one before it).
Here you go
functions <- list()
functions[[1]] <- function(x){
x
}
for (i in 2:10)
{
functions[[i]] <- function(x,i){
functions[[i-1]](x) + x
}
formals(functions[[i]])$i <- i
}
functions[[10]](5)
# 50
The function testfun1, defined below, does what I want it to do. (For the reasoning of all this, see the background info below the code example.) The question I wanted to ask you is why what I tried in testfun2 doesn't work. To me, both appear to be doing the exact same thing. As shown by the print in testfun2, the evaluation of the helper function inside testfun2 takes place in the correct environment, but the variables from the main function environment get magically passed to the helper function in testfun1, but not in testfun2. Does anyone of you know why?
helpfun <- function(){
x <- x^2 + y^2
}
testfun1 <- function(x,y){
xy <- x*y
environment(helpfun) <- sys.frame(sys.nframe())
x <- eval(as.call(c(as.symbol("helpfun"))))
return(list(x=x,xy=xy))
}
testfun1(x = 2,y = 1:3)
## works as intended
eval.here <- function(fun){
environment(fun) <- parent.frame()
print(environment(fun))
eval(as.call(c(as.symbol(fun))))
}
testfun2 <- function(x,y){
print(sys.frame(sys.nframe()))
xy <- x*y
x <- eval.here("helpfun")
return(list(x=x,xy=xy))
}
testfun2(x = 2,y = 1:3)
## helpfun can't find variable 'x' despite having the same environment as in testfun1...
Background info: I have a large R code in which I want to call helperfunctions inside my main function. They alter variables of the main function environment. The purpose of all this is mainly to unclutter my code. (Main function code is currently over 2000 lines, with many calls to various helperfunctions which themselves are 40-150 lines long...)
Note that the number of arguments to my helper functions is very high, so that the traditional explicit passing of function arguments ( "helpfun(arg1 = arg1, arg2 = arg2, ... , arg50 = arg50)") would be cumbersome and doesnt yield the uncluttering of the code that I am aiming for. Therefore, I need to pass the variables from the parent frame to the helper functions anonymously.
Use this instead:
eval.here <- function(fun){
fun <- get(fun)
environment(fun) <- parent.frame()
print(environment(fun))
fun()
}
Result:
> testfun2(x = 2,y = 1:3)
<environment: 0x0000000013da47a8>
<environment: 0x0000000013da47a8>
$x
[1] 5 8 13
$xy
[1] 2 4 6
I am constructing an approximating function recursively (adaboost). I would like to create the resulting learning function along the way (not to apply the approximation directly to my test data but keep the function that leads to it)
unfortunately, it seems that R updates the value to which a variable name refers to long after it is used.
#defined in plyr as well
id <- function(x) {x}
#my first classifier
modelprevious <- function(inputx, k) { k(0)}
#one step of my superb model
modelf <- function(x) 2*x #for instance
#I update my classifier
modelCurrent <- function(inputx, k)
{ modelprevious(inputx, function(res) {k(res + modelf(inputx))})}
#it works
modelCurrent(2,id) #4
#Problem
modelf <- function(x) 3*x
modelCurrent(2,id) #6 WTF !!
The same function with the same argument return something different, which is quite annoying !
So how is it possible to capture the value represented by modelf so that the resulting function only depends on its argument at the time of the binding, and not of some global state ?
Given that problem I dont see how one can do a recursive function building in R if one can not touch local variable, apart going through ugly hacks of quote/parse
You need a factory:
modelCurrent = function(mf){
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
Now you use the factory to create models with the modelf function that you want it to use:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
> modelf <- function(x) 3*x
> m1(2,id) # no change.
[1] 4
You can always make them on an ad-hoc basis:
> modelCurrent(modelf)(2,id)
[1] 6
and there you can see the factory created a function using the current definition of modelf, so it multiplied by three.
There's one last ginormous WTF!?! that will hit you. Watch carefully:
> modelf <- function(x) 2*x
> m1 = modelCurrent(modelf)
> m1(2,id)
[1] 4
>
> m1 = modelCurrent(modelf) # create a function using the 2* modelf
> modelf <- function(x) 3*x # change modelf...
> m1(2,id) # WTF?!
[1] 6
This is because when the factory is called, mf isn't evaluated - that's because the inner function isn't called, and mf isn't used until the inner function is called.
The trick is to force evaluation of the mf in the outer function, typically using force:
modelCurrent = function(mf){
force(mf)
return(function(inputx,k){
modelprevious(
inputx,
function(res){
k(res+mf(inputx))
} # function(res)
) # modelprevious
} # inner function
) # return
} # top function
This has lead me to premature baldness, because if you forget this and think there's some odd bug going on, and then try sticking print(mf) in place to see what's going on, you'll be evaluating mf and thus getting the behaviour you wanted. By inspecting the data, you changed it! A Heisenbug!