How to add functions in R - r

I am trying to sum the functions in a list to create a new function. This is easy for a small number of functions. Here is an example:
f <- function(x){x}
g <- function(x){x+1}
Now we sum f and g.
fg <- function(x){f(x) + g(x)}
But if I have 100 functions that I want to sum, this method becomes clumsy. Is there a way to create a function like fg above automatically from a list?

I prefer Reduce:
f <- function(x){x}
g <- function(x){x+1}
h <- function(x){x*2}
funs<-list(f,g,h)
x <- 1:3
Reduce("+", lapply(funs, function(f, y) f(y), y=x))
#[1] 5 9 13
Of course, the return values of all functions must have the same length.

You could use sapply to loop over the functions and apply then
f <- function(x){x}
g <- function(x){x+1}
h <- function(x){x*2}
funs<-list(f,g,h)
x <- 2
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
# [1] 9
I use the matrix and rowSums functions just in case you want to be able to call it when x is a vector of values as well
x <- 1:3
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
# [1] 5 9 13
You can make it cleaner by making a helper function
getfunsum <- function(funs) {
force(funs)
function(x) {
rowSums(matrix(sapply(funs, function(f, z) f(z), z=x), nrow=length(x)))
}
}
fgh <- getfunsum(funs)
fgh(1:3)
# [1] 5 9 13

You may try:
fun1 <- function(i,a) {
eval(substitute(function(x, a) {x+i*a}, list(i=i)))}
n <- 0:3
lst <- lapply(n, fun1)
rowSums(sapply(lst, function(f) f(12:14, 3)))
#[1] 66 70 74

Related

Is there a way to use do.call without explicitly providing arguments

Part of a custom function I am trying to create allows the user to provide a function as a parameter. For example
#Custom function
result <- function(.func){
do.call(.func, list(x,y))
}
#Data
x <- 1:2
y <- 0:1
#Call function
result(.func = function(x,y){ sum(x, y) })
However, the code above assumes that the user is providing a function with arguments x and y. Is there a way to use do.call (or something similar) so that the user can provide a function with different arguments? I think that the correct solution might be along the lines of:
#Custom function
result <- function(.func){
do.call(.func, formals(.func))
}
#Data
m <- 1:3
n <- 0:2
x <- 1:2
y <- 0:1
z <- c(4,6)
#Call function
result(.func = function(m,n){ sum(m, n) })
result(.func = function(x,y,z){ sum(x,y,z) })
But this is not it.
1) Use formals/names/mget to get the values in a list. An optional argument, envir, will allow the user to specify the environment that the variables are located in so it knows where to look. The default if not specified is the parent frame, i.e. the caller.
result1 <- function(.func, envir = parent.frame()) {
do.call(.func, mget(names(formals(.func)), envir))
}
m <- 1:3
n <- 0:2
x <- 1:2
y <- 0:1
z <- c(4,6)
result1(.func = function(m,n) sum(m, n) )
## [1] 9
result1(.func = function(x,y,z) sum(x,y,z) )
## [1] 14
result1(function(Time, demand) Time + demand, list2env(BOD))
## [1] 9.3 12.3 22.0 20.0 20.6 26.8
1a) Another possibility is to evaluate the body. This also works if envir is specified as a data frame whose columns are to be looked up.
result1a <- function(.func, envir = parent.frame()) {
eval(body(.func), envir)
}
result1a(.func = function(m,n) sum(m, n) )
## [1] 9
result1a(.func = function(x,y,z) sum(x,y,z) )
## [1] 14
result1a(function(Time, demand) Time + demand, BOD)
## [1] 9.3 12.3 22.0 20.0 20.6 26.8
2) Another design which is even simpler is to provide a one-sided formula interface. Formulas have environments so we can use that to look up the variables.
result2 <- function(fo, envir = environment(fo)) eval(fo[[2]], envir)
result2(~ sum(m, n))
## [1] 9
result2(~ sum(x,y,z))
## [1] 14
result2(~ Time + demand, BOD)
## [1] 9.3 12.3 22.0 20.0 20.6 26.8
3) Even simpler yet is to just pass the result of the computation as an argument.
result3 <- function(x) x
result3(sum(m, n))
## [1] 9
result3(sum(x,y,z))
## [1] 14
result3(with(BOD, Time + demand))
## [1] 9.3 12.3 22.0 20.0 20.6 26.8
This works.
#Custom function
result <- function(.func){
do.call(.func, lapply(formalArgs(.func), as.name))
}
#Data
m <- 1:3
n <- 0:2
x <- 1:2
y <- 0:1
z <- c(4,6)
#Call function
result(.func = function(m,n){ sum(m, n) })
result(.func = function(x,y,z){ sum(x,y,z) })
This seems like a bit of a pointless function, since the examples in your question imply that what you are trying to do is evaluate the body of the passed function using variables in the calling environment. You can certainly do this easily enough:
result <- function(.func){
eval(body(.func), envir = parent.frame())
}
This gives the expected results from your examples:
x <- 1:2
y <- 0:1
result(.func = function(x,y){ sum(x, y) })
#> [1] 4
and
m <- 1:3
n <- 0:2
x <- 1:2
y <- 0:1
z <- c(4,6)
result(.func = function(m,n){ sum(m, n) })
#> [1] 9
result(.func = function(x,y,z){ sum(x,y,z) })
#> [1] 14
But note that, when the user types:
result(.func = function(x,y){ ...user code... })
They get the same result they would already get if they didn't use your function and simply typed
...user code....
You could argue that it would be helpful with a pre-existing function like mean.default:
x <- 1:10
na.rm <- TRUE
trim <- 0
result(mean.default)
#> [1] 5.5
But this means users have to name their variables as the parameters being passed to the function, and this is just a less convenient way of calling the function.
It might be useful if you could demonstrate a use case where what you are proposing doesn't make the user's code longer or more complex.
You could also use ..., but like the other responses, I don't quite see the value, or perhaps I don't fully understand the use-case.
result <- function(.func, ...){
do.call(.func, list(...))
}
Create function
f1 <- function(a,b) sum(a,b)
Pass f1 and values to result()
result(f1, m,n)
Output:
[1] 9
Here is how I would do it based on your clarifying comments.
Basically since you say your function will take a data.frame as input, the function you are asking for essentially just reverses the order of arguments you pass to do.call()... which takes a function, then a list of arguments. A data.frame is just a special form of list where all elements (columns) are vectors of equal length (number of rows)
result <- function(.data, .func) {
# .data is a data.frame, which is a list of argument vectors of equal length
do.call(.func, .data)
}
result(data.frame(a=1, b=1:5), function(a, b) a * b)
result(data.frame(c=1:10, d=1:10), function(c, d) c * d)

Function to apply mean on a list of vectors without need to list the vectors (changes to a function call)

I have multiple objects and I need to apply some function to them, in my example mean. But the function call shouldn't include list, it must look like this: my_function(a, b, d).
Advise how to do it please, probably I need quote or substitute, but I'm not sure how to use them.
a <- c(1:15)
b <- c(1:17)
d <- c(1:19)
my_function <- function(objects) {
lapply(objects, mean)
}
my_function(list(a, b, d))
A possible solution:
a <- c(1:15)
b <- c(1:17)
d <- c(1:19)
my_function <- function(...) {
lapply(list(...), mean)
}
my_function(a, b, d)
#> [[1]]
#> [1] 8
#>
#> [[2]]
#> [1] 9
#>
#> [[3]]
#> [1] 10
To still be able to benefit from the other arguments of mean such as na.rm= and trim=, i.e. to generalize, we may match the formalArgs with the dots and split the call accordingly.
my_function <- function(...) {
cl <- match.call()
m <- match(formalArgs(base:::mean.default), names(cl), 0L)
vapply(as.list(cl)[-c(1L, m)], function(x) {
eval(as.call(c(quote(base:::mean.default), list(x), as.list(cl[m]))))
}, numeric(1L))
}
## OP's example
my_function(a, b, d)
# [1] 8 9 10
## generalization:
set.seed(42)
my_function(rnorm(12), rnorm(5), c(NA, rnorm(3)))
# [1] 0.7553736 -0.2898547 NA
set.seed(42)
my_function(rnorm(12), rnorm(5), c(NA, rnorm(3)), na.rm=TRUE)
# 0.7553736 -0.2898547 -1.2589363
set.seed(42)
my_function(rnorm(12), rnorm(5), c(NA, rnorm(3)), na.rm=TRUE, trim=.5)
# 0.5185655 -0.2787888 -2.4404669
Data:
a <- 1:15; b <- 1:17; d <- 1:19

R assign along a vector

I have an ini-file, read as a list by R (in the example l). Now I want to add further sub-lists along a vector (m) and assign always the same constant to them. My attempt so far:
l <- list("A")
m <- letters[1:5]
n <- 5
for (i in 1:5){
assign(paste0("l$A$",m[i]), n)
}
# which does not work
# example of the desired outcome:
> l$A$e
[1] 5
I don't think that I have fully understood how lists work yet...
Try
L[["A"]][m] <- n
L$A$e
# [1] 5
Data:
L <- list(A = list())
m <- letters[1:5]
n <- 5

Why can I not use the output of my function to get an output for my other defined function in R?

For my class, I am trying to create a function that gives my output as a reduced fraction of x and y from my function called GCD, which finds the greatest common divisor
Let's let x <- 85 and y <- 5 for simplicity
GCD(85,5)
[1] 5
simplify_rat <- function(85,5) {
GCD(x,y)
gcd <- c(GCD(x,y))
n <- (y/gcd)
d <- (x/gcd)
print(cat(n, "/", d, "\n"))
}
But I get this output with no reduced fraction
[1] 5
[1] 5
/
NULL
Why am I not able to use the output from GCD? Is there a way to make this usable?
Always pass variable parameters to your functions:
require(DescTools)
simplify_rat <- function(x,y) {
gcd <- c(GCD(x,y))
n <- (y/gcd)
d <- (x/gcd)
cat(n, "/", d, "\n")
}
simplify_rat(85,5)
1 / 17

R: How to write a function that replaces a function call with another function call?

E.g. I want to transform the code
mean(x)
to
fn(x)
everytime I see mean in the code.
replace_mean <- function(code) {
substitute(code, list(mean = fn)) # doesn't work
substitute(substitute(code), list(mean = fn)) # doesn't work
}
the above two approaches don't work. E.g.
replace_mean(list(mean(y), mean(x)))
What's the best way to do function replacement using NSE in R?
Base R Solutions preferred.
Update example output
replace(mean(x)) # fn(x)
replace(list(a = mean(x), mean(ok))) # list(a=fn(x), fn(ok)))
The following function, when passed mean(x) and some fn such as sqrt as its two arguments returns the call object fn(x), i.e. sqrt(x), replacing occurrences of mean with fn.
replace_mean <- function(code, fn) {
do.call("substitute", list(substitute(code), list(mean = substitute(fn))))
}
Examples
1) Basic example
e <- replace_mean(mean(x), sqrt)
e
## sqrt(x)
x <- 4
eval(e)
## [1] 2
2) more complex expression
ee <- replace_mean(mean(x) + mean(x*x), sqrt)
ee
## sqrt(x) + sqrt(x * x)
x <- 4
eval(ee)
## [1] 6
3) apply replace_mean to body of f creating g
f <- function(x) mean(x) + mean(x*x)
g <- f
body(g) <- do.call("replace_mean", list(body(f), quote(sqrt)))
g
## function (x)
## sqrt(x) + sqrt(x * x)
x <- 4
g(x)
## [1] 6
One way is much more ugly and relies on string manipulation to generate the code you want to run and then evaluating it.
replace_mean <- function(code) {
code_subbed = substitute(code)
# constructu the code I want
code_subbed_subbed = sprintf("substitute(%s, list(mean=quote(fn)))", deparse(code_subbed))
eval(parse(text = code_subbed_subbed))
}
replace_mean(list(mean(x), a= mean(ok)))

Resources