I have two functions, as for example:
a <- function(x) return(mean(x))
b <- function(x) return(median(x))
I would like to have another function that passes either a or b as an argument.
The goal is something like this:
oper <- function(f, x) {
ifelse(f == "a", a(x), b(x))
}
If for example I was to execute the function:
oper(a, c(3,4,5))
I get the following error message:
Error in f == "a" :
comparison (1) is possible only for atomic and list types
Disclosure: mean(x) and median(x) are just for example purposes.
Because R has first-class functions, you can simply pass your function and call it directly:
oper2 <- function(f, x) {
f(x)
}
x <- c(2, 3, 8)
oper2(a, x)
# 4.333333
oper2(b, x)
# 3
Related
In R, I can calculate the first-order derivative as the following:
g=expression(x^3+2*x+1)
gPrime = D(g,'x')
x = 2
eval(g)
But I think it's not very readable. I prefer to do something like this:
f = function(x){
x^3+2*x+1
}
fPrime = D(g,'x') #This doesn't work
fPrime(2)
Is that possible? Or is there a more elegant way to do ?
1) D This depends on the particular form of f but for similar ones whose body is one line surrounded by {...} and whose single argument is x and whose operations are in the derivative table this works:
# f is from question
f = function(x){
x^3+2*x+1
}
df <- function(f) {
fun <- function(x) {}
environment(fun) <- environment(f)
body(fun) <- D(body(f)[[2]], "x")
fun
}
df(f)
## function (x)
## 3 * x^2 + 2
2) numDeriv::grad Also consider doing this numerically:
library(numDeriv)
grad(f, 2)
## [1] 14
3) deriv Another approach is to use deriv in the base of R with similar restrictions to (1).
df2 <- function(f) {
fun <- function(x) {
f2 <- deriv(body(f)[[2]], "x", function.arg = TRUE)
attr(f2(x), "gradient")
}
environment(fun) <- environment(f)
fun
}
f2Prime <- df2(f)
f2Prime(2)
## x
## [1,] 14
4) Deriv::Deriv Another apprroach is the Deriv package.
library(Deriv)
Deriv(f, "x")
## function (x)
## 2 + 3 * x^2
Similar to the question here. Given a function f with named arguments and a function g taking any number of arguments through ..., how would one
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f()
Error in g(a = a) : argument "a" is missing, with no default
rlang::dots_list sadly did not provide an answer
f2 <- function(a)
h(a = a)
h <- function(...)
rlang::dots_list(..., .ignore_empty = 'all')
f2()
Error in eval(expr, p) : argument "a" is missing, with no default
Edit:
To make the problem more clear, the function g may be called by a myriad of functions, and I'm looking for a way to handle the missing arguments within g and not f.
You can forward ... to subfunctions to multiple depths without evaluating them as long as the subfunctions don't actually perform any evaluation themselves so you don't have to handle this in all functions that receive ... but at the point where it is evaluated you will need to deal with it somehow.
Assuming that f() should return a empty list handle the missing argument separately within g
f <- function(a) g(a = a)
g <- function(..., default = list()) if (missing(..1)) default else list(...)
f()
## [1] list()
or the following which checks each element of ... :
g <- function(..., default = list()) {
L <- list()
for(i in seq_len(...length())) {
x <- try(eval.parent(list(...)[[i]]), silent = TRUE)
L[[i]] <- if (inherits(x, "try-error")) default else x
}
names(L) <- names(substitute(alist(...))[-1])
L
}
f()
## $a
## list()
or within f:
f <- function(a) if (missing(a)) g() else g(a = a)
g <- function(...) list(...)
f()
## [1] list()
Your code seems to be OK except you call f() without a argument at the end... try this:
f <- function(a)
g(a = a)
g <- function(...)
list(...)
f("example")
Or you have to provide a default value for a:
f <- function(a = "example")
g(a = a)
g <- function(...)
list(...)
f()
So the problem is not a missing argument in g(...), but missing argument value in f() when calling g(a = a) without having a.
I'd like to be able to pass current arguments in a function to another function without individually listing each of the arguments. This is for a slightly more complex function which will have about 15 arguments with potentially more arguments later added (it's based on an API for data which might have more complex data added later):
f_nested <- function(a, b, ...) {
c <- a + b
return(c)
}
f_main <- function(a, b) {
d <- do.call(f_nested, as.list(match.call(expand.dots = FALSE)[-1]))
c <- 2 / d
return(c)
}
f_main(2, 3)
#> [1] 0.4
sapply(2:4, function(x) f_main(x, 4))
#> Error in (function (a, b, ...) : object 'x' not found
Created on 2019-06-28 by the reprex package (v0.3.0)
The first call to f_main(2, 3) produces the expected result. However, when iterating over a vector of values with sapply an error arises that the object was not found. I suspect my match.call() use is not correct and I'd like to be able to iterate over my function.
I'll borrow from lm's used of match.call, replacing the first element with the next function. I think one key is to call eval with the parent.frame(), so that x will be resolved correctly.
# no change
f_nested <- function(a, b, ...) {
c <- a + b
return(c)
}
# changed, using `eval` instead of `do.call`, reassigning the function name
f_main <- function(a, b) {
thiscall <- match.call(expand.dots = TRUE)
thiscall[[1]] <- as.name("f_nested")
d <- eval(thiscall, envir = parent.frame())
c <- 2 / d
return(c)
}
sapply(2:4, function(x) f_main(x, 4))
# [1] 0.3333333 0.2857143 0.2500000
As #MrFlick suggested, this can be shortened slightly with:
f_main <- function(a, b) {
thiscall <- match.call(expand.dots = TRUE)
thiscall[[1]] <- as.name("f_nested")
d <- eval.parent(thiscall)
c <- 2 / d
return(c)
}
Inside an R function, is it possible to detect if the user has assigned the output to an object?
For example, I would like to print on console some information only if the output is not assigned to an object, I am looking for something like this
fun <- function(a){
b <- a^2
if(!<OUTPUT ASSIGNED>) cat('a squared is ', b)
return(invisible(b))
}
So that the result on console would be different whether the function output is assigned or not, e.g:
> fun(5)
> a squared is 25
>
> out <- fun(5)
>
>
Not sure if I've completely thought this one through, but this seems to work for the example you've given. (Note it's important to use = or assign or .Primitive("<-") inside the fun you'd like to subject to this treatment.)
fun <- function(a){
b = a^2 # can't use <- here
if (!identical(Sys.getenv("R_IS_ASSIGNING"), "true")) cat('a squared is ', b)
return(invisible(b))
}
`<-` <- function(a, b) {
Sys.setenv("R_IS_ASSIGNING" = "true")
eval.parent(substitute(.Primitive("<-")(a, b)))
Sys.unsetenv("R_IS_ASSIGNING")
}
fun(5)
#> a squared is 25
out <- fun(6)
out
#> [1] 36
Created on 2019-02-17 by the reprex package (v0.2.1)
If I correctly understand what do you need it's better to use custom print method:
print.squared_value = function(x, ...){
cat('a squared is', x, "\n")
x
}
fun = function(a){
b = a^2
class(b) = union("squared_value", class(b))
b
}
fun(2)
# a squared is 4
UPDATE:
fun = function(a){
b = a^2
invisible(b)
}
h = taskCallbackManager()
# add a callback
h$add(function(expr, value, ok, visible) {
# if it was a call 'fun' without assinment
if(is.call(expr) && identical(expr[[1]], quote(fun))){
cat('a squared is', value, "\n")
}
return(TRUE)
}, name = "simpleHandler")
fun(2)
# a squared is 4
b = fun(2)
b
# [1] 4
# remove handler
removeTaskCallback("R-taskCallbackManager")
If I understood well, this could do the trick:
fun <- function(a){
b <- a^2
if(sum(unlist(lapply(lapply(ls(envir = .GlobalEnv), get), function(x){ identical(x,a^2)})))==0) cat('a squared is ', b)
return(invisible(b))
}
So:
ls(envir=.GlobalEnv) will return all objects in your global environment
lapply(ls(envir = .GlobalEnv), get): will return a list with the content of all objects in your global environment
lapply(lapply(ls(envir = .GlobalEnv), get), function(x){ identical(x,a^2)}): will return a logical list checking if the content of any of all objects in your global environment is identical to the output of your function
sum(unlist(lapply(lapply(ls(envir = .GlobalEnv), get), function(x){ identical(x,a^2)})))==0 if none of the content of any of all objects is identical to hte ouput of your function, then... cat!
I hope this helps you!
Best!
I am building a simple R package with many auxiliary functions. One of the main function uses a lot of the auxiliary ones as such:
....
#'# description
#'# param
#'# export
...
mainfunction1 <- function(param1,...,auxiliaryfunction){
# Do some stuff
b <- auxiliaryfunction(param2) + c
return(b)
}
...
#'# description
#'# param
auxiliaryfunction1 <- function(param5,param6,...){# do stuff}
The main function should be used by the final user as such:
result1 <- mainfunction1(param1, param2, auxiliaryfunction1)
The problem is that when the package is built, it never finds the auxiliary functions unless they are exported, however I'd like them not be available to the final user or at least avoid the problem of the user overriding them by mistake by referring to the package namespace.
How can I do this?
Should I export the auxiliary functions too?
You are trying to solve a non-problem.
If you want a user to use a function, export it.
If you don't want a user to use a function, do not export it.
That said...
There is a possibility that you are getting caught up on how functions are passed as arguments to other functions. Functions are first class objects in R, so they can be passed around very easily. Consider the following example:
m <- function(x, y) x + y
n <- function(x, y) x - y
k1 <- function(x, y, FUN) FUN(x, y)
k1(10, 5, FUN = m)
# [1] 15
k1(10, 5, FUN = n)
# [1] 5
k2 <- function(x, y, FUN = m) FUN(x, y)
k2(10, 5) # uses `m()` by default
# [1] 15
k2(10, 5, FUN = m)
# [1] 15
k2(10, 5, FUN = n)
# [1] 5
If you really don't want to users to access the functions directly but want to give them choice over which to use, then define the auxiliary functions in the body of the main function and use, for example, a switch() to choose between them:
fun <- function(x, method = c("A", "B")) {
m <- match.arg(method)
a <- function(x) x^2
b <- function(x) sqrt(x)
switch(m, A = a(x), B = b(x))
}
fun(2)
# [1] 4
fun(2, "A")
# [1] 4
fun(2, "B")
# [1] 1.414214