Setting conditional(ifelse) arguments in a function - r

I have a simple function and one of its arguments needs to be made conditional, in the sense:
IFELSE NOT MISSING take the given value
IFELSE NOT EXISTS then give some default value
ELSE give the global value of that argument
something like this:
f <- function(x,y=ifelse(!missing("y"),y,ifelse(!exists("y"),1,get("y",envir=.GlobalEnv))))
{
assign("y",y,envir=.GlobalEnv)
return(x+y)
}
required outputs:
# :f(3) should give me 4 with global y=1
# :f(4,2) should give me 6 with global y=2
# :f(5) should give me 7 with global y=2
#Note that y does not exist when we first run the function
running the above function with f(3) gives me:- Error in get("y", envir = .GlobalEnv) : object 'y' not found
If i specify y in the first-go then the function works perfectly, but I want it to run even if the user doesnt specify the y argument in the first-go
Any suggestions?
Thanks.
EDIT:
#Richard i dont think it matters if missing() is in the function or in the argument, in any case try to do the same using this function:
f <- function(x,y)
{
y=ifelse(!missing("y"),y,ifelse(!exists("y"),1,get("y",envir=.GlobalEnv)))
assign("y",y,envir=.GlobalEnv)
return(x+y)
}

First, I'll begin by stating that I don't recommend you do this. You'll be messing around with reassignment of global objects, which can be dangerous and lead to trouble if you need to go back and recall a value that you've overwritten.
Next, missing should not be used in the argument list of a function. It should be used in the function body to check the arguments in the argument list, and has specific usage that is noted in the help file.
That said, if you must do it, here you go.
f <- function(x, y)
{
if(missing(y)) {
y <- if(exists("y", envir = .GlobalEnv)) {
get("y", envir = .GlobalEnv)
} else {
1L
}
}
assign("y", y, .GlobalEnv)
x + y
}
> rm(y)
> f(3)
#[1] 4
> f(4, 2)
#[1] 6
> f(5)
#[1] 7

Try:
f <- function(x,y=NULL)
{
y = ifelse( !is.null(y), y,
ifelse(!exists("y"), 1,get("y",envir=.GlobalEnv)
)
)
assign("y",y,envir=.GlobalEnv)
return(x+y)
}
If y does not exist, try:
f <- function(x,y)
{
if(missing("y") || !exists('y')) y = 1
assign("y",y,envir=.GlobalEnv)
x+y
}

Related

R: Using output from one function to set all attributes of another function

I want the output of one function to be able to set all, or possibly only the needed/given, attributes of another. I want to use the output of myFunction1() on its own, which does some calculations and based on that produces multiple needed values, or in combination with myFunction2(), which is supposed to use those values in a plot or similar. The code would look something like this:
myFunction1() >%> myFunction2()
I'm aware that I can possibly put the function that needs the output inside the first function, like:
myFunction1=function(x, logical){
x=x^2
y=""
if(x>100){
y="hello"
}else{
y="goodbye"
}
if(logical){
return(list(x=x,y=y,logical=logical))
}else{
return(myFunction2(x,y,logical))
}
} ##end myFunction1()
myFunction2=function(x, y, z){
a=paste0(x, y, z)
return(a)
}
or use the output with the $-operator
myOutput = myFunction(1, TRUE)
myOutput2 = myFunction2(myOutput$x, myOutput$y, myOutput$logical)
But is there a way to have a list output (or anything that can contain different data types) be able to set all attributes without the need of addressing the output via $ or index?
(First post so feedback regarding the wrongs would be appreciated aswell)
If the question is asking how to create a pipeline from myFunction1 and myFunction2 assuming we can modify myFunction1 but not myFunction2 then remove the test from myFunction1 and put it into the pipeline as shown.
myFunction1 <- function(x, logical) {
y <- if (x^2 > 100) "hello" else "goodbye"
list(x = x, y = y, logical = logical)
}
myFunction2 <- function(x, y, z) {
paste0(x, y, z)
}
# tests - 3 alternatives
library(magrittr)
# 1 - with
myFunction1(1, TRUE) %>%
with(if (logical) myFunction2(x, y, logical) else .)
## [1] "1goodbyeTRUE"
# 2 - magrittr %$%
myFunction1(1, TRUE) %$%
if (logical) myFunction2(x, y, logical) else .
## [1] "1goodbyeTRUE"
# 3 - do.call
myFunction1(1, TRUE) %>%
{ if (.$logical) do.call("myFunction2", unname(.)) else . }
## [1] "1goodbyeTRUE"
If we can modify both we could have myFunction2 accept a list.
myFunction2 <- function(List) {
if (List$logical) do.call("paste0", List) else List
}
myFunction1(1, TRUE) %>% myFunction2
## [1] "1goodbyeTRUE"

ISO a good way to let a function accept a mix of supplied arguments, arguments from a list, and defaults

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"

Pass optional arguments to function, three dots

I'm confused how ... works.
tt = function(...) {
return(x)
}
Why doesn't tt(x = 2) return 2?
Instead it fails with the error:
Error in tt(x = 2) : object 'x' not found
Even though I'm passing x as argument ?
Because everything you pass in the ... stays in the .... Variables you pass that aren't explicitly captured by a parameter are not expanded into the local environment. The ... should be used for values your current function doesn't need to interact with at all, but some later function does need to use do they can be easily passed along inside the .... It's meant for a scenario like
ss <- function(x) {
x
}
tt <- function(...) {
return(ss(...))
}
tt(x=2)
If your function needs the variable x to be defined, it should be a parameter
tt <- function(x, ...) {
return(x)
}
If you really want to expand the dots into the current environment (and I strongly suggest that you do not), you can do something like
tt <- function(...) {
list2env(list(...), environment())
return(x)
}
if you define three dots as an argument for your function and want it to work, you need to tell your function where the dots actually go. in your example you are neither defining x as an argument, neither ... feature elsewhere in the body of your function. an example that actually works is:
tt <- function(x, ...){
mean(x, ...)
}
x <- c(1, 2, 3, NA)
tt(x)
#[1] NA
tt(x, na.rm = TRUE)
#[1] 2
here ... is referring to any other arguments that the function mean might take. additionally you have a regular argument x. in the first example tt(x) just returns mean(x), whilst in the second example tt(x, na.rm = TRUE), passes the second argument na.rm = TRUE to mean so tt returns mean(x, na.rm = TRUE).
Another way that the programmers of R use a lot is list(...) as in
tt <- function(...) {
args <- list(...) # As in this
if("x" %in% names(args))
return(args$x)
else
return("Something else.")
}
tt(x = 2)
#[1] 2
tt(y = 1, 2)
#[1] "Something else."
I believe that this is one of their favorite, if not the favorite, way of handling the dots arguments.

R get object from global environment from function if object exists in global but use different default if not

Surely this is possible, but I can't seem to find how to do it:
I'd like to have a default of a function input, but override the default and get() a variable from the global environment if it exists in the global environment. If it doesn't exist in the global environment, take the default of the function, with any setting in the function being top level and overriding them all.
Ideally it would work like this made-up non-working function:
###Does not work, desired example
myfunc <- function(x=30){
if(exists.in.global.env(x)){x <- get(x)}
###Top level is tough
if(x.is.defined.as.function.input=TRUE ????){x <- x.defined.as.input}
}else{ x <- 30}
return(x)
}
So that if I do:
myfunc()
[1] 30
But if I create x I want it to override the default x=30 of the function and take the global environment value instead:
x <- 100
myfunc()
[1] 100
But if I have x defined inside the function, I'd like that to be top level, i.e. override everything else even if x is defined globally:
x <- 100
myfunc(x=300)
[1] 300
Thanks in advance!
You can modify your function to check if x exists in the .GlobalEnv and get it from there if it does, otherwise return the default value.
myfunc <- function(x = 30) {
if ("x" %in% ls(envir = .GlobalEnv)) {
get("x", envir = .GlobalEnv)
} else {
x
}
}
So if "x" %in% ls(envir = .GlobalEnv) is FALSE it would return
myfunc()
[1] 30
If x is found it would return it. if x <- 100:
myfunc()
[1] 100
Edit after comment
If you want to make sure to only return x from the global environment if x is not specified as an argument to myfunc, you can use missing(). It returns TRUE if x was not passed and FALSE if it was:
myfunc <- function(x = 30) {
if ("x" %in% ls(envir = .GlobalEnv) & missing(x)) {
get("x", envir = .GlobalEnv)
} else {
x
}
}
So for your example:
x <- 100
myfunc(x=300)
[1] 300
The simplest method would be to set an appropriate default argument:
myfunc <- function(x=get("x", globalenv())
{
x
}
> x <- 100
> f()
[1] 100
> f(30)
[1] 30
> rm(x)
> f()
Error in get("x", globalenv()) : object 'x' not found

Lazy evaluation of supplied arguments

Say I have the following function:
foo <- function(x, y = min(m)) {
m <- 1:10
x + y
}
When I run foo(1), the returned value is 2, as expected. However, I cannot run foo(1, y = max(m)) and receive 11, since lazy evaluation only works for default arguments. How can I supply an argument but have it evaluate lazily?
The simple answer is that you can't and shouldn't try to. That breaks scope and could wreak havoc if it were allowed. There are a few options that you can think about the problem differently.
first pass y as a function
foo<-function(x,y=min){
m<-1:10
x+y(m)
}
if a simple function does not work you can move m to an argument with a default.
foo<-function(x,y=min(m),m=1:10){
x+y(m)
}
Since this is a toy example I would assume that this would be too trivial. If you insist on breaking scope then you can pass it as an expression that is evaluated explicitly.
foo<-function(x,y=expression(min(m))){
m<-1:10
x+eval(y)
}
Then there is the option of returning a function from another function. And that might work for you as well, depending on your purpose.
bar<-function(f)function(x,y=f(m)){
m<-1:10
x+y
}
foo.min<-bar(min)
foo.min(1) #2
foo.max<-bar(max)
foo.max(1) #10
But now we are starting to get into the ridiculous.
My solution was to just change the default argument:
R> formals(foo)$y <- call("max", as.name("m"))
R> foo(1)
[1] 11
You can use a substitute, eval combintation.
foo <- function(x, y = min(m)) {
y <- substitute(y)
m <- 1:10
x + eval(y)
}
foo(1)
## [1] 2
foo(1, y = max(m))
## [1] 11

Resources