I want to write an R function that takes a mathematical function in x
and returns a new function in x
as an output. For example:
The input should be passed in as a mathematical function (or relation) in x
:
g <- x^2 + 9*x + log(x)
And the resulting output should be:
function(x) (exp(g))
i.e. I want to return the symbolic exponential expression of the original function in x
i.e. exp(x^2 + 9*x + log(x))
in this illustrative example
So ideally it would return the function object:
function(x) (exp(x^2 + 9*x + log(x)))
I tried as follows:
test <- function(g){
h <- function(x){exp(g)}
return(h)
}
m <- test(x^2 + 9*x + log(x))
m(10)
So m(10) should return:
exp(10^2 + 9*10 + log(10))
which is exp(192.3026) in this case.
Could anyone show how to do this please?
You could use package functional:
library(functional)
fun <- Compose(function(x) x^2 + 9*x + log(x), exp)
fun(1)
#[1] 22026.47
Here is one approach:
test <- function(e) {
ee <- substitute(e)
eee <- substitute(exp(X), list(X=ee))
f <- function(x) {}
body(f) <- eee
environment(f) <- parent.frame()
f
}
## Check that it works
m <- test(x^2 + 9*x + log(x))
m
# function (x)
# exp(x^2 + 9 * x + log(x))
m(1)
# [1] 22026.47
m(1) == exp(10)
# [1] TRUE
edit - for functionality in question
f <- function(...) {
l <- eval(substitute(alist(x = x, ...)))
l[[2]] <- substitute(exp(X), list(X = l[[2]]))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x^2 + 2*x + 5)
# function (x = x)
# exp(x^2 + 2 * x + 5)
g(1)
# [1] 2980.958
Here is another way for a general case:
f <- function(...) {
l <- eval(substitute(alist(...)))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
g <- f(x, x^2 + 9*x + log(x))
# function (x = x)
# x^2 + 9 * x + log(x)
g(10)
# [1] 192.3026
This version will also work for any number of variables, just define them followed by the function:
g <- f(x, y, z, x + 2 * y + z ** 3)
# function (x = x, y = y, z = z)
# x + 2 * y + z^3
g(1, 2, 0)
# [1] 5
There may be a better way to add ...
to functions, but here is how you can do that
f <- function(..., use_dots = FALSE) {
l <- eval(substitute(alist(...)))
if (use_dots)
l <- c(head(l, -1), list('...' = as.symbol('...')), tail(l, 1))
as.function(`names<-`(l, l[sapply(l, is.symbol)]))
}
So now you don't have to name all the variables/arguments
g <- f(x, y, plot(x, y, ...), use_dots = TRUE)
g(1:5, 1:5, main = 'main title', pch = 16, col = 3, cex = 3, xpd = NA)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With