R: solving for a variable - r

I wonder if there's any function that can solve for a variable in an equation in terms of other values.
For example, I have:
(a-1/3)/(a+b-2/3)==0.3
The output of this function should be:
(0.3*b+0.1333333)/(0.7)
Or something along these lines.
Thank you

You can use Yacas through the Ryacas package:
library(Ryacas)
a <- Sym("a")
b <- Sym("b")
Solve((a-1/3)/(a+b-2/3)==0.3, a)
# Yacas vector:
# [1] a == -((-0.3 * b - 0.1333333333)/0.7)
To get the solution as an expression, do:
solution <- Solve((a-1/3)/(a+b-2/3)==0.3, a)
yacas(paste0("a Where ", solution))
# expression(-((-0.3 * b - 0.1333333333)/0.7))
You can define a function returning the solution in function of b as follows:
f <- function(b) {}
body(f) <- yacas(paste0("a Where ", solution))$text
f
# function (x)
# -((-0.3 * b - 0.1333333333)/0.7)
Also note that you do rational calculus to get exact values:
q1 <- Sym(1)/Sym(3)
q2 <- Sym(2)/Sym(3)
solution <- Solve((a-q1)/(a+b-q2)==0.3, a)
solution
# [1] a == -(3 * (-0.3 * b - 1.2/9)/2.1)
Simplify(solution)
# [1] a + (-0.9 * b/2.1 - 3.6/18.9) == 0

Related

How to calculate integral inside an integral in R?

I need to evaluate an integral in the following form:
\int_a^b f(x) \int_0^x g(t)(x-t)dtdx
Can you please suggest a way? I assume that this integral can't be done in the standard approach suggested in the following answer:
Standard approach
Update: Functions are added in the following image. f(x) basically represents a pdf of a uniform distribution but the g(t) is a bit more complicated. a and b can be any positive real numbers.
The domain of integration is a simplex (triangle) with vertices (a,a), (a,b) and (b,b). Use the SimplicialCubature package:
library(SimplicialCubature)
alpha <- 3
beta <- 4
g <- function(t){
((beta/t)^(1/2) + (beta/t)^(3/2)) * exp(-(t/beta + beta/t - 2)/(2*alpha^2)) /
(2*alpha*beta*sqrt(2*pi))
}
a <- 1
b <- 2
h <- function(tx){
t <- tx[1]
x <- tx[2]
g(t) * (x-t)
}
S <- cbind(c(a, a), c(a ,b), c(b, b))
adaptIntegrateSimplex(h, S)
# $integral
# [1] 0.01962547
#
# $estAbsError
# [1] 3.523222e-08
Another way, less efficient and less reliable, is:
InnerFunc <- function(t, x) { g(t) * (x - t) }
InnerIntegral <- Vectorize(function(x) { integrate(InnerFunc, a, x, x = x)$value})
integrate(InnerIntegral, a, b)
# 0.01962547 with absolute error < 2.2e-16

Solving an algebraic equation

I'm trying to solve this equation: ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) =1
Is there a way to do this with R?
ATTEMPT with incorrect solution:
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
# simplify the equation:
library(glue)
yac_str(glue("Simplify({eq})"))
library(evaluate)
evaluate(eq,list(x=c(0,1,10,100,-100)))
evaluate() just returns the equation:
"((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
The answer for the equation is −2004200
It sounds like you want to Solve() for x rather than merely simplifying ... ? The following code solves the equation, strips off the x== from the solution, and evaluates the expression:
eq2 <- gsub("x==","",yac_str(glue("Solve({eq},x)")))
[1] "{(-0.80168e6)/0.4}"
eval(parse(text=eq2))
[1] -2004200
1) Ryacas Use the Ryacas package solve as shown below. (Thanks to #mikldk for improvement to last line.)
library(Ryacas)
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res <- solve(ysym(eq), "x")
as_r(y_rmvars(res)) # extract and convert to R
## [1] -2004200
if eq has R variables in it, here h is referenced in eq2, then use eval to evaluate the result.
h <- 2300
eq2 <- "((h+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 " # from question
res2 <- solve(ysym(eq2), "x")
eval(as_r(y_rmvars(res2)))
## [1] -2004200
2) Ryacas0 or using eq from above with the Ryacas0 package:
library(Ryacas0)
res <- Solve(eq, "x")
eval(Expr(res)[[1:3]]) # convert to R
## [1] -2004200
3a) Base R In light of the fact that this is a linear equation and the solution to the following where A is the slope and B is the intercept:
A * x + B = 0
is
x = - B / A
if we replace x with the imaginary 1i and then move the rhs to the lhs we have that B and A are the real and imaginary parts of that expression. No packages are used.
r <- eval(parse(text = sub("==", "-", eq)), list(x = 1i))
-Re(r) / Im(r)
## [1] -2004200
3b) If we move the rhs to lhs then B equals it at x=0 and A equals the derivative wrt x so another base R solution would be:
e <- parse(text = sub("==", "-", eq))
- eval(e, list(x = 0)) / eval(D(e, "x"))
## [1] -200420
Here is a base R solution.
Rewrite the equation in the form of a function, use curve to get two end points where the function has different signs and put uniroot to work.
f <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) - 1
curve(f, -1e7, 1)
uniroot(f, c(-1e7, 1))
#$root
#[1] -2004200
#
#$f.root
#[1] 0
#
#$iter
#[1] 1
#
#$init.it
#[1] NA
#
#$estim.prec
#[1] 7995800
Following the discussion in the comments to the question, here is a general solution. The function whose roots are to be found now accepts an argument params in order to pass the values of rent, salary, number of workers, price, unit cost and capital cost. This argument must be a named list.
f <- function(x, K = 1, params) {
A <- with(params, rent + salary*workers)
with(params, (A + (x + A)*capitalcost)/(price - unitcost) - K)
}
params <- list(
rent = 2300,
salary = 1900,
workers = 1,
price = 600,
unitcost = 400,
capitalcost = 0.002
)
curve(f(x, params = params), -1e7, 1)
uniroot(f, c(-1e7, 1), params = params)
If you want something quick: rootSolve library is your go-to.
library(rootSolve)
func_ <- function(x) ((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400)-1
uniroot.all(func_, c(-1e9, 1e9))
[1] -2004200
Note that most of the time reducing the interval is better.
If you will maintain the same structure, then in Base R, you could do:
solveX <- function(eq){
U <- function(x)abs(eval(parse(text = sub("=+","-", eq)), list(x=x)))
optim(0, U, method = "L-BFGS-B")$par
}
eq <- "((2300+1900*1)+(x+2300+1900*1)*0.002)/(600-400) ==1 "
solveX(eq)
[1] -2004200

eigen analysis of variables in R

Is there a way to evaluate Eigen information without using numbers/values in R?
Here is my example, I am working with a three equation system from Bairagi et al 2007, Role of infection on the stability of a predator–prey system with several
response functions—A comparative study. I would like to know if there is a way to analyze a jacobian without using numbers/values (using variables, instead). Following is my example:
Equations
dsdtau = expression(b*s-b*s^2-b*s*i-s*i-m*s*p)
didtau = expression(s*i - d*i*p - e*i)
dpdtau = expression(-theta*d*i*p - g*p + theta*m*s*p)
Partial derivatives
dsds <- D(dsdtau,"s")
dids <- D(dsdtau,"i")
dpds <- D(dsdtau,"p")
dsdi <- D(didtau,"s")
didi <- D(didtau,"i")
dpdi <- D(didtau,"p")
dsdp <- D(dpdtau,"s")
didp <- D(dpdtau,"i")
dpdp <- D(dpdtau,"p")
Jacobian
j1 <- matrix(c(
dsds,dids,dpds,
dsdi,didi,dpdi,
dsdp,didp,dpdp),
nrow = 3, byrow = TRUE)
First, is there a way to coerce R into giving me the full details in matrix form? For example, when I run
j1
I get
[,1] [,2] [,3]
[1,] Expression Expression Expression
[2,] ? Expression Expression
[3,] Expression Expression Expression
but when I run j1[1], I get:
b - b * (2 * s) - b * i - i - m * p
which is what I want.
Second, is there a way to analyze this jacobian using the variables rather than plugging in values? For example, at (s,i,p) = (0,0,0) there is a trivial equilibrium with lambda = (b,-e,-g) which is an unstable saddle point (as all variables are greater than 0) and not particularly exciting. But for non-trivial equilibria the math is more labor intensive, and if R knows a way, I'd love help figuring it out!
If you're open to storing j1 as a list, here's a way to explicitly show each expression. As far as evaluating goes, that's something I would need more time to investigate. For now, the following list of functions seems promising: match.call(), do.call(), eval(), and get().
# store j1
# as a list object
# naming each set of equations
j1 <-
list(
didtau = c( dsds,dids,dpds )
, dpdtau = c( dsdi,didi,dpdi )
, dsdtau = c( dsdp,didp,dpdp )
)
# view the list
j1
# $didtau
# $didtau[[1]]
# b - b * (2 * s) - b * i - i - m * p
#
# $didtau[[2]]
# -(b * s + s)
#
# $didtau[[3]]
# -(m * s)
#
#
# $dpdtau
# $dpdtau[[1]]
# i
#
# $dpdtau[[2]]
# s - d * p - e
#
# $dpdtau[[3]]
# -(d * i)
#
#
# $dsdtau
# $dsdtau[[1]]
# theta * m * p
#
# $dsdtau[[2]]
# -theta * d * p
#
# $dsdtau[[3]]
# -theta * d * i - g + theta * m * s
# end of script #

Computing geometric series in R

I would like to compute:
$\sum_{j=1}^n r^j$ for $n=10, 20, 30, 40$, where $r=1.08$
http://quicklatex.com/cache3/76/ql_b64b957d43a0d6a93418cb18eb752576_l3.png
and to see the answers as a vector. I'm working with R; could anyone is able to explain to me how to do this?
So you are playing with power series. You may do:
r <- 1.08 ## this will be a divergent series, toward `Inf`
rr <- r^(1:40)
cumsum(rr)[1:4 * 10]
# [1] 15.64549 49.42292 122.34587 279.78104
The theoretical value is
## define a function
f <- function (n, r) r * (1 - r ^ n) / (1 - r)
## call this function
f(1:4 * 10, 1.08)
# [1] 15.64549 49.42292 122.34587 279.78104
Note, the theoretical result is not (1 - r ^ (n + 1)) / (1 - r), as you start summation from j = 1 instead of j = 0.
The value of r is unstated and I guessing that the formula being requested is not really the correct solution to a compound interest problem, but here is one answer to the question as currently posed:
r = 5.3; for (n in c(10,20,30,40) ) print( sum( r^(1:n) ) )
[1] 21555896
[1] 3.769856e+14
[1] 6.593006e+21
[1] 1.153034e+29
Perhaps (if I interpreted the latex right):
library(purrr)
r <- 1.08
map_dbl(seq(10, 40, 10), function(n) {
sum(r^(1:n))
})
Using only for loop and getting output as a vector:
out=c();
for(i in c(10,20,30,40))
{sum=0;
for(j in 1:i)
{sum=sum+1.08^j};
out=c(out,sum)};
out
Output:
[1] 15.64549 49.42292 122.34587 279.78104
Or:
> out=c();
> for(i in c(10,20,30,40))
+ out=c(out,sum(1.08^(1:i)))
> out
[1] 15.64549 49.42292 122.34587 279.78104
or, in R way:
> sapply(seq(10,40,10), function(x) sum(1.08^(1:x)))
[1] 15.64549 49.42292 122.34587 279.78104

solving set of linear equations using R for plane 3D equation

I have some trouble in order to solve my set of linear equations.
I have three 3D points (A, B, C) in my example and I want to automate the solving of my system. I want to create a plane with these 3 points.
It's very simple manually (mathematically) but I don't see why I don't solve my problem when I code...
I have a system of cartesian equation which is the equation of a plane : ax+by+cz+d=0
xAx + yAy + zA*z +d = 0 #point A
xBx + yBy + zB*z +d = 0 #point B
etc
I use a matrix, for example A=(0,0,1) ; B=(4,2,3) and C=(-3,1,0).
With manual solving, I have for this example this solution : x+3y-5z+5=0.
For resolving it in R : I wanted to use solve().
A <- c(0,0,1)
B <- c(4,2,3)
C <- c(-3,1,0)
res0 <- c(-d,-d,-d) #I don't know how having it so I tried c(0,0,0) cause each equation = 0. But I really don't know for that !
#' #param A vector 3x1 with the 3d coordinates of the point A
carteq <- function(A, B, C, res0) {
matrixtest0 <- matrix(c(A[1], A[2], A[3], B[1], B[2], B[3],C[1], C[2], C[3]), ncol=3) #I tried to add the 4th column for solving "d" but that doesn't work.
#checking the invertibility of my matrix
out <- tryCatch(determinant(matrixtest0)$modulus<threshold, error = function(e) e)#or out <- tryCatch(solve(X) %*% X, error = function(e) e)
abcd <- solve(matrixtest0, res0) #returns just 3 values
abcd <- qr.solve(matrixtest0, res0) #returns just 3 values
}
That's not the good method... But I don't know how I can add the "d" in my problem.
The return that I need is : return(a, b, c, d)
I thing that my problem is classical and easy, but I don't find a function like solve() or qr.solve() which can solve my problem...
Your solution is actually wrong:
A <- c(0,0,1)
B <- c(4,2,3)
C <- c(-3,1,0)
CrossProduct3D <- function(x, y, i=1:3) {
#http://stackoverflow.com/a/21736807/1412059
To3D <- function(x) head(c(x, rep(0, 3)), 3)
x <- To3D(x)
y <- To3D(y)
Index3D <- function(i) (i - 1) %% 3 + 1
return (x[Index3D(i + 1)] * y[Index3D(i + 2)] -
x[Index3D(i + 2)] * y[Index3D(i + 1)])
}
N <- CrossProduct3D(A - B, C - B)
#[1] 4 2 -10
d <- -sum(N * B)
#[1] 10
#test it:
crossprod(A, N) + d
# [,1]
#[1,] 0
crossprod(B, N) + d
# [,1]
#[1,] 0
crossprod(C, N) + d
# [,1]
#[1,] 0

Resources