I am trying to combine multiple expressions in R into a single expression. Ideally, I would be able to do something like this:
g <- expression(exp(a[1]*x)/(1 + exp(a[1]*x)))
h <- expression(exp(a[2]*x)/(1 + exp(a[2]*x)))
c <- expression(g * h)
where a is a given vector of data and x is the only unknown (and it is the same unknown across all expressions). c would return
R> c
expression(exp(a[1]*x)/(1 + exp(a[1]*x)) * exp(a[2]*x)/(1 + exp(a[2]*x)))
Right now, when I do this I just get
R> c
expression(g * h)
I want to have an equation
(source: lehrfeld.me)
into which I could plug some vector a to obtain a function of x. What am I doing wrong here?
Don't use expressions, use functions. The
From what I can decipher, the following will do what you want
# a function for a vector `x` and single value `a`
func <- function(x,a) { (exp(1)^(a*x)/(1 + exp(1)^(a*x))) }
# a function for a vector `x` and vector length 2 for `a`
foo <- function(x, a){func(x,a[1]) * func(x, a[2])}
# call the function to calculate what you want.
foo(x,a)
And if you want the expression associated with this so you can plot the text of the equation, the following will work
expr <- expression(exp(1)^(a*x)/(1 + exp(1)^(a*x))
g <- do.call(substitute, list(as.list(expr)[[1]], env= list(a=3)))
h<- do.call(substitute, list(as.list(expr)[[1]], env= list(a=2)))
'%c%' <- function(a,b) bquote(.(a) %*% .(b))
fooExpr <- g %c% h
this is an old question but surprisingly, no easy answer has been given. As said in a comment, "R is not a symbolic algebra program"; however, R has all necessary means for manipulating expressions. I have no idea how to do it with expressions (in the technical sense, see ?expression) but it is trivially easy with calls:
g <- quote(exp(a[1]*x)/(1 + exp(a[1]*x)))
h <- quote(exp(a[2]*x)/(1 + exp(a[2]*x)))
substitute(g*h, list(g=g, h=h))
# exp(a[1] * x)/(1 + exp(a[1] * x)) * (exp(a[2] * x)/(1 + exp(a[2] * x)))
There are probably easier ways to achieve what you want (maybe using functions) but this is the easiest way to merge two "calls" (i.e. expressions in the "colloquial" sense as defined by R wizards).
Creating the expression from other expressions is more straightforward (IMO) using rlang, than base R. Use the !! (bang-bang) to force evaluation of an object within an expression.
library(rlang)
a <- c(2, 3)
g <- expr(exp(!!a[1] * x) / (1 + exp(!!a[1] * x)))
h <- expr(exp(!!a[2] * x) / (1 + exp(!!a[2] * x)))
c <- expr(!!g * !!h)
c
#> exp(2 * x)/(1 + exp(2 * x)) * (exp(3 * x)/(1 + exp(3 * x)))
Created on 2020-03-21 by the reprex package (v0.3.0)
You may want a function not an expression I think:
newfunc <- function(x) {
(exp(1)^(2*x)/(1 + exp(1)^(2*x))) *
(exp(1)^(3*x)/(1 + exp(1)^(3*x)))
}
a <- 1:10
newfunc(a)
[1] 0.8390245 0.9795856 0.9974043 0.9996585 0.9999543 0.9999938 0.9999992
[8] 0.9999999 1.0000000 1.0000000
If you want to chain together multiple functions explicitly, you could just do:
newfunc1 <- function(x) {
(exp(1)^(2*x)/(1 + exp(1)^(2*x)))
}
newfunc2 <- function(x) {
(exp(1)^(3*x)/(1 + exp(1)^(3*x)))
}
newfunc1(a) * newfunc2(a)
Keep in mind, as the help file at ?expression says:
‘Expression’ here is not being used in its colloquial sense, that
of mathematical expressions. Those are calls (see ‘call’) in R,
and an R expression vector is a list of calls, symbols etc, for
example as returned by ‘parse’.
You could define a binary function to combine expression objects in a slightly hacky way -- get their character representation, paste them with a *, then re-parse it:
"%c%" <- function(x, y) parse( text=paste(x, "*", y) )
gives the desired output when calling g %c% h, for example.
EDIT: Answer updated to correct previous error; thanks mnel!
Related
I am new to R and programming in general and am trying to write a very basic function where the input is 2 numbers and a selection from one of 3 operations. The output is supposed to be the result of a further calculation (divide the result of the input by 3*pi) and then a character string to confirm what operation was selected/performed. I want the default operation to be addition.
I've read up a little on the switch function and if... else type statements but not sure what is the most efficient way to achieve what I am trying to do and so far I haven't been able to get anything to work anyway. I seem to be getting a massive matrix as the output or an error to say I can't return multiple arguments in my current attempt. Can someone help with where I am going wrong? Thank you in advance.
basiccalc <- function(x, y, operation = addition){
addition <- x + y
subtraction <- x - y
multiplication <- x * y
calculation <- operation/(3*pi)
return(calculation, "operation")
}
switch would be useful
basiccalc <- function(x, y, operation = addition) {
operation <- deparse(substitute(operation))
op <- switch(operation,
addition = x + y,
subtraction = x - y,
multiplication = x * y)
return(op/(3 *pi))
}
-testing
> basiccalc(3, 5)
[1] 0.8488264
> 8/(3 * pi)
[1] 0.8488264
> basiccalc(3, 5, operation = subtraction)
[1] -0.2122066
> (3- 5)/(3 * pi)
[1] -0.2122066
I run WolframAlpha through R
Wolfram Alpha API from R
My problem is, that I need to convert wolfram output to R expression.
I have added "*" where it's needed, there's another issue - converting of goniometric functions.
Example:
I have: cos^3(5 + 2*x)
I need to get: (cos(5 + 2*x))^3
Could somebody give me a hint how to achieve the expression? Or is there any package for conversion? Or does somebody suggest any other way?
SOLUTION by #G. Grothendieck
sub("(sin|cos|tan)\\^(\\(?-?\\d+\\)?)", "(function(x) \\1(x)^\\2)", 'cos^3(5 + 2*x)')
Define a function called cos^3, insert backticks into the original string around it and evaluate.
`cos^3` <- function(x) cos(x)^3
s <- sub("cos^3", "`cos^3`", input_string, fixed = TRUE) # `cos^3`(5 + 2*x)
x <- .5 # test value for x
eval(parse(text = s))
## [1] 0.8852069
This could be generalized a bit if need be like this:
input_string <- "cos^(3)(5+2*x)"
sub("(sin|cos|tan)\\^(\\(?-?\\d+\\)?)", "(function(x) \\1(x)^\\2)", input_string)
## [1] "(function(x) cos(x)^(3))(5+2*x)"
I think that you have the original formula as a string and want to evaluate it in R (with the modified syntax). You can change the formula using sub and then evaluate it using parse and eval.
F1 = "cos^3(5 + 2*x)"
F2 = sub("(.*)(\\^\\d)(.*)", "\\1\\3\\2", F1)
F2
[1] "cos(5 + 2*x)^3"
x = 1:4
eval(parse(text=F2))
[1] 4.284944e-01 -7.563824e-01 8.668527e-08 7.472458e-01
Here's a solution to your specific case, which should help getting started on a more general solution (this will work for strings of the form 'cos^X(Y)' where X is some digits and Y is an arithmetic expression):
input_string <- 'cos^3(5 + 2*x)'
desired_output_string <- '(cos(5 + 2*x))^3'
convert_string <- function(s){
return(gsub('(cos)(\\^\\d+)(\\([a-z0-9+* ]+\\))', '(\\1\\3)\\2', s))
}
output_string <- convert_string(input_string)
if (output_string == desired_output_string){
message('the output matches!')
} else { message('try again </3') }
And then if you need to actually evaluate the string, you can use eval(parse(text=output_string)), making sure that all variables it contains have values:
x <- 5
eval(parse(text=output_string))
## -0.4384354
I want to avoid using parse() in a function definition that contains a polynomial().
My polynomial is this:
library(polynom)
polynomial(c(1, 2))
# 1 + 2*x
I want to create a function which uses this polynomial expression as in:
my.function <- function(x) magic(polynomial(c(1, 2)))
where for magic(), I have tried various combinations of expression(), formula(), eval(), as.character(), etc... but nothing seems to work.
My only working solution is using eval(parse()):
eval(parse(text = paste0('poly_function <- function(x) ', polynomial(c(1, 2)))))
poly_function(x = 10)
# 21
Is there a better way to do want I want? Can I avoid the eval(parse())?
Like you, I though that the polynomial function was returning an R expression, but we were both wrong. Reading the help Index for package:polynom would have helped us both:
str(pol)
#Class 'polynomial' num [1:2] 1 2
help(pac=polynom)
So user20650 is correct and:
> poly_function <- as.function(pol)
> poly_function(10)
[1] 21
So this was how the authors (Venables, Hornick, Maechler) do it:
> getAnywhere(as.function.polynomial)
A single object matching ‘as.function.polynomial’ was found
It was found in the following places
registered S3 method for as.function from namespace polynom
namespace:polynom
with value
function (x, ...)
{
a <- rev(coef(x))
w <- as.name("w")
v <- as.name("x")
ex <- call("{", call("<-", w, 0))
for (i in seq_along(a)) {
ex[[i + 2]] <- call("<-", w, call("+", a[1], call("*",
v, w)))
a <- a[-1]
}
ex[[length(ex) + 1]] <- w
f <- function(x) NULL
body(f) <- ex
f
}
<environment: namespace:polynom>
Since you mention in your comments that getAnywhere was new then it also might be the case that you could gain by reviewing the "run up" to using it. If you type a function name at the console prompt, you get the code, in this case:
> as.function
function (x, ...)
UseMethod("as.function")
<bytecode: 0x7f978bff5fc8>
<environment: namespace:base>
Which is rather unhelpful until you follow it up with:
> methods(as.function)
[1] as.function.default as.function.polynomial*
see '?methods' for accessing help and source code
The asterisk at the end of the polynomial version tells you that the code is not "exported", i.e. available at the console just by typing. So you need to pry it out of a loaded namespace with getAnywhere.
It seems like you could easily write your own function too
poly_function = function(x, p){
sum(sapply(1:length(p), function(i) p[i]*x^(i-1)))
}
# As 42- mentioned in comment to this answer,
# it appears that p can be either a vector or a polynomial
pol = polynomial(c(1, 2))
poly_function(x = 10, p = pol)
#[1] 21
#OR
poly_function(x = 10, p = c(1,2))
#[1] 21
In math, when combining functions, you can indicate this using ordinary arithmetic operations, e.g.
u = 2*x
v = log(x)
and then simply
f = u + v
I do a lot of numerical work where you have to construct complicated math operations. It would be very helpful to be able to use a notation more like this one. For example, in R it might look like
f <- function.arithmetic('u+v', args=c('x'))
With some nonstandard evaluation, this might even be as simple as
f(x) %def% u + v
where u and v are already defined functions of x.
Is there a simple way to set up this syntax? For example, breaking down the expression and substituting u(x) and v(x) wherever they occur -- then doing an ordinary eval. (I would trust an existing parsing function more than some hack that I write. And I know that "parse" doesn't do this.)
Answers already suggested would work, but they seem more complicated than writing
f <- function(x) u(x) + v(x)
If the expression is more complicated, this notation starts getting harder to read. I want to set up something simpler, more easily readable, and closer to the above mathematical notation.
Here are a couple of approaches:
1) Ops/Math This could be done using S3 or S4. We illustrate S3 only.
Compose <- function(f, g) {
if (missing(g)) structure(f, class = c("functional", "function"))
else Compose(function(...) f(g(...)))
}
Ops.functional <- function(e1, e2) {
op <- match.fun(.Generic)
Compose( if (is.numeric(e1)) function(...) op(e1, e2(...))
else if (is.numeric(e2)) function(...) op(e1(...), e2)
else function(...) op(e1(...), e2(...)))
}
Math.functional <- function(x, ...) {
op <- match.fun(.Generic)
Compose(op, x)
}
Here are two examples:
u <- Compose(function(x) 2*x)
v <- Compose(log)
(u + v)(pi/2) # example 1
## [1] 3.593175
(exp(u*v) / (1 + u^2 + v^2)) (pi/2) # example 2
## [1] 0.3731149
Note: that u could have alternately been defined as u <- 2 * Compose(identity) . In fact, we could define:
Id <- Compose(identity)
u <- 2*Id
v <- log(Id)
2) Define your own functions This is not really much work. Likely less than a page to define all common functions. This could be done using the %...% infix operators but if you really want to go the infix route (1) above seems preferable. So with this approach we keep it simple. The following could be enhanced to allow numeric arguments to be regarded as constant functions as we did in (1).
Plus <- function(f, g) function(...) f(...) + g(...)
Plus(function(x) 2*x, log)(pi/2)
## [1] 3.593175
This is G.Grothendieck's answer cast in the form of an infix "+"-operator:
`%+%` <- function(f1, f2) { function(x) {f1(x) +f2(x)} }
f <- cos %+% sin
f
#-----
function(x) {f1(x) +f2(x)}
<environment: 0x7ffccd7eeea8>
#-------
f(0)
#[1] 1
There are also examples of functional composition on the 'funprog' page which needs to be pulled up with one of the function names, for instance?Reduce. Can also be defined to accept additional arguments:
`%+%` <- function(f1, f2) { function(x,...) {f1(x,...) +f2(x,...)} }
f2 <- dt %+% dt
#-- testing---
> f2(0)
Error in f1(x, ...) : argument "df" is missing, with no default
> f2(0, 6)
[1] 0.7654655
> dt(0,6)
[1] 0.3827328
To see how this is handled internally you can recover the definition by examining the environment stored with the resulting closure:
> ls(envir=environment(f2) )
[1] "f1" "f2"
> environment(f2)$f1
function (x, df, ncp, log = FALSE)
{
if (missing(ncp))
.Call(C_dt, x, df, log)
else .Call(C_dnt, x, df, ncp, log)
}
<bytecode: 0x7ffcc63e8ff8>
<environment: namespace:stats>
The problem with your example is that you did not define the u and v in an R-functional manner. Presumably this would not be the situation with your proposed use case.
> u = function(x,...)2*x
> v = function(x,...) (log(x))
> f <- u %+% v
> f(4)
[1] 9.386294
Some of this style of programming may be supported by Hadley's lazyeval package:
> require(lazyeval)
Loading required package: lazyeval
> help(pac=lazyeval)
> lazy_eval(interp(~ u + v, u = sum(1:10), v=sum(1:5)) )
[1] 70
> x <- 1:10; y=1:5
> lazy_eval(interp(~ u + v, u = sum(x), v=sum(y)) )
[1] 70
> lazy_eval(interp(~ u / v, u = sum(x), v=sum(y)) )
[1] 3.666667
> lazy_eval(interp(~ log(u) / v, u = sum(x), v=sum(y)) )
[1] 0.2671555
But I have encountered some puzzles that I cannot really understand:
e2 <- ~ exp(u * v)/(1 + x)^2
lazy_eval(interp(e2, u = sum(x)/100, v=sum(y)/100) )
#[1] 0.271499668 0.120666519 0.067874917 0.043439947 0.030166630 0.022163238 0.016968729
#[8] 0.013407391 0.010859987 0.008975196
exp( sum(x)/100 +sum(y)/100 )/(1+x)^2
[1] 0.50343818 0.22375030 0.12585954 0.08055011 0.05593758 0.04109699 0.03146489 0.02486114
[9] 0.02013753 0.01664258
Here is my R code. The functions are defined as:
f <- function(x, T) {
10 * sin(0.3 * x) * sin(1.3 * x ^ 2) + 0.001 * x ^ 3 + 0.2 * x + 80
}
g <- function(x, T, f=f) {
exp(-f(x) / T)
}
test <- function(g=g, T=1) {
g(1, T)
}
The running error is:
> test()
Error in test() :
promise already under evaluation: recursive default argument reference or earlier problems?
If I substitute the definition of f in that of g, then the error goes away.
I was wondering what the error was? How to correct it if don't substitute the definition of f in that of g? Thanks!
Update:
Thanks! Two questions:
(1) if function test further takes an argument for f, will you add something like test <- function(g.=g, T=1, f..=f){ g.(1,T, f.=f..) } ? In cases with more recursions, is it a good and safe practice adding more .?
(2) if f is a non-function argument, for example g <- function(x, T, f=f){ exp(-f*x/T) } and test <- function(g.=g, T=1, f=f){ g.(1,T, f=f.) }, will using the same name for both formal and actual non-functional arguments a good and safe practice or it may cause some potential trouble?
Formal arguments of the form x=x cause this. Eliminating the two instances where they occur we get the following. (The reason you can't use x=x in the formal arguments of a function definition is that it first looks up the default argument within the function itself so using that form is telling it to use itself as the default but it has not been defined so that makes no sense and we get an error.)
f <- function(x, T) {
10 * sin(0.3 * x) * sin(1.3 * x^2) + 0.001 * x^3 + 0.2 * x + 80
}
g <- function(x, T, f. = f) { ## 1. note f.
exp(-f.(x)/T)
}
test<- function(g. = g, T = 1) { ## 2. note g.
g.(1,T)
}
test()
## [1] 8.560335e-37
If you especify argument evaluation context, you avoid the problem of same name:
f <- function(x) {
10 * sin(0.3 * x) * sin(1.3 * x ^ 2) + 0.001 * x ^ 3 + 0.2 * x + 80
}
g <- function(x, t=1, f=parent.frame()$f) {
exp(-f(x) / t)
}
test <- function(g=parent.frame()$g, t=1) {
g(1,t)
}
test()
[1] 8.560335e-37
As already mentioned, the problem comes from having a function argument defined as itself. However, I want to add an explanation of why this is a problem because understanding that led me to an easier (for me) way to avoid the problem: just specify the argument in the call instead of the definition.
This does not work:
x = 4
my.function <- function(x = x){}
my.function() # recursive error!
but this does work:
x = 4
my.function <- function(x){}
my.function(x = x) # works fine!
Function arguments exist in their own local environment.
R looks for variables first in the local environment, then in the global environment. This is just like how inside a function a variable can have the same name as a variable in the global environment, and R will use the local definition.
Having function argument definitions form their own local environment is why you can have default argument values based on other argument values, like
my.function <- function(x, two.x = 2 * x){}
So this is why you cannot DEFINE a function as my.function <- function(x = x){} but you can CALL the function using my.function(x = x). When you define the function, R gets confused because it finds the argument x = as the local value of x, but when you call the function R finds x = 4 in the local environment you are calling from.
So in addition to fixing the error by changing the argument name or explicitly specifying the environment as mentioned in other answers, you can also just specify that x=x when you call the function instead of when you define it. For me, specifying that x=x in the call was the best solution, since it does not involve extra syntax or accumulating more and more variable names.
I like the G. Grothendieck answer, but I was wondering that is more simple in your case to not include function names in the parameters of functions, like this:
f <- function(x, T) {
10 * sin(0.3 * x) * sin(1.3 * x^2) + 0.001 * x^3 + 0.2 * x + 80
}
g <- function(x, T) {
exp(-f(x)/T)
}
test<- function(T = 1) {
g(1,T)
}
test()
## [1] 8.560335e-37