I've been trying to find a function that returns all complex solutions of an equation such as:
16^(1/4) = 2+i0, -2+i0, 0+i2, 0-i2
As it stands, if I enter 16^(1/4) into the console, it only returns 2. I can write a function for this but I was wondering if there is a simple way to do this in R.
You need polyroot():
polyroot(z = c(-16,0,0,0,1))
# [1] 0+2i -2-0i 0-2i 2+0i
Where z is a "vector of polynomial coefficients in increasing order".
The vector I passed to z in the example above is a compact representation of this equation:
-16x^0 + 0x^1 + 0x^2 + 0x^3 + 1x^4 = 0
x^4 - 16 = 0
x^4 = 16
x = 16^(1/4)
Edit:
If polyroot's syntax bothers you, you just could write a wrapper function that presents you with a nicer (if less versatile) interface:
nRoot <- function(x, root) {
polyroot(c(-x, rep(0, root-1), 1))
}
nRoot(16, 4)
# [1] 0+2i -2-0i 0-2i 2+0i
nRoot(16, 8)
# [1] 1.000000+1.000000i -1.000000+1.000000i -1.000000-1.000000i
# [4] 1.000000-1.000000i 0.000000+1.414214i -1.414214-0.000000i
# [7] 0.000000-1.414214i 1.414214+0.000000i
Related
The code below estimates pi in R, now I am trying to find the minimum number of terms N_Min
you would have to include in your estimate of pie to make it accurate to three decimal places.
pi_Est<- function(NTerms){
NTerms = 5 # start with an estimate of just five terms
pi_Est = 0 # initialise the value of pi to zero
Sum_i = NA # initialise the summation variable to null
for(ii in 1:NTerms)
{
Sum_i[ii] = (-1)^(ii+1)/(2*ii - 1) # this is the series equation for calculating pi
}
Sum_i = 4*Sum_i # multiply by four as required in the formula (see lecture notes)
pi_Est = sum(Sum_i)
cat('\nThe estimate of pi with terms = ', NTerms ,' is ',pi_Est)
}
First of all, I would change some things about your function. Instead of getting it to print out a message, get it to return a value. Otherwise it becomes very difficult to do anything with its output, including testing it for convergence to pi.
Also, no matter what the value of NTerms is you feed this function, you are immediately over-writing NTerms inside the function.
You could rewrite the function like this:
pi_Est <- function(NTerms) {
pi_Est <- 0
Sum_i <- numeric()
for(ii in seq(NTerms))
{
Sum_i[ii] <- (-1)^(ii+1)/(2*ii - 1)
}
return(sum(4 * Sum_i))
}
And to show it converges to pi, let's test it with 50,000 terms:
pi_Est(50000)
#> [1] 3.141573
Now, if we want to find the first value of NTerms that is correct to 3 decimal places, we are going to need to be able to call this function on a vector of NTerms - at the moment it is only working on a single number. So let's define the function f that vectorizes pi_Est:
f <- Vectorize(pi_Est)
Now, let's create the estimate for all values of NTerms between 1 and 2,000 and store them in a vector:
estimates <- f(1:2000)
We can see that the values of estimates seem to oscillate round and converge to pi if we plot the first 100 values:
plot(estimates[1:100], type = 'l')
abline(h = pi)
Our answer is just the first value which, when rounded to three decimal places, is the same as pi rounded to three decimal places:
result <- which(round(estimates, 3) == round(pi, 3))[1]
result
#> [1] 1103
And we can check this is correct by feeding 1103 into our original function:
pi_Est(result)
#> [1] 3.142499
You will see that this gives us 3.142, which is the same as pi rounded to 3 decimal places.
Created on 2022-01-31 by the reprex package (v2.0.1)
1000 terms are required to make the estimate accurate to within 0.001:
pi_Est1 <- function(n) {
if (n == 0) return(0)
neg <- 1/seq(3, 2*n + 1, 4)
if (n%%2) neg[length(neg)] <- 0
4*sum(1/seq(1, 2*n, 4) - neg)
}
pi_Est2 <- function(tol) {
for (i in ceiling(1/tol + 0.5):0) {
est <- pi_Est1(i)
if (abs(est - pi) > tol) break
est1 <- est
}
list(NTerms = i + 1, Estimate = est1)
}
tol <- 1e-3
pi_Est2(tol)
#> $NTerms
#> [1] 1000
#>
#> $Estimate
#> [1] 3.140593
tol - abs(pi - pi_Est2(tol)$Estimate)
#> [1] 2.500001e-10
tol - abs(pi - pi_Est1(pi_Est2(tol)$NTerms - 1))
#> [1] -1.00075e-06
Created on 2022-01-31 by the reprex package (v2.0.1)
Perhaps we can try the code below
pi_Est <- function(digits = 3) {
s <- 0
ii <- 1
repeat {
s <- s + 4 * (-1)^(ii + 1) / (2 * ii - 1)
if (round(s, digits) == round(pi, digits)) break
ii <- ii + 1
}
list(est = s, iter = ii)
}
and you will see
> pi_Est()
$est
[1] 3.142499
$iter
[1] 1103
> pi_Est(5)
$est
[1] 3.141585
$iter
[1] 130658
Why not use a single line of code for the calculation?
Pi <- tail(cumsum(4*(1/seq(1,4*50000000,2))*rep(c(1,-1), 50000000)),1)
I want to build a function that takes E[x] and Var[X] and give me the mean and standard error of a univariate lognormal variable.
E[x] = exp(mu + theta)
Var[x] = exp(2*mu + theta)*(exp(theta) - 1)
The function would take E[x] and Var[x] as input and as output would give me theta and mu
There are several packages that provide ways and means to solve a system of nonlinear equations. One of these is nleqslv.
You nee to provide a function that function that returns the differences between the actual value of the equations and the desired value.
Load package nleqslv and define the following function
library(nleqslv)
f <- function(x,Ex,Varx) {
y<- numeric(length(x))
mu <- x[1]
theta <- x[2]
y[1] <- exp(mu+theta) - Ex
y[2] <- exp(2*mu+theta)*(exp(theta)-1) - Varx
y
}
The vector x in the function contains the values of mu and theta.
An example with Ex=2 and Varx=3 and some random starting values
xstart <- c(1,1)
nleqslv(xstart,f,Ex=2,Varx=3)
gives the following
$x
[1] -0.6931472 1.3862944
$fvec
[1] -8.095125e-11 -8.111645e-11
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 31
$njcnt
[1] 2
$iter
[1] 22
See the manual of nleqslv for the meaning of the different elements of the return value of nleqslv.
If you want to investigate the effect of the different solving methods try this
testnslv(xstart,f,Ex=2,Varx=3)
I've been trying to code this problem:
https://sg.answers.yahoo.com/question/index?qid=20110127015240AA9RjyZ
I believe there is a R function somewhere to solve for the root values of the following equations:
(x+3)^2 + (y-50)^2 = 1681
(x-11)^2 + (y+2)^2 = 169
(x-13)^2 + (y-34)^2 = 625
I tried using the 'solve' function but they're only for linear equations(?)
Also tried 'nls'
dt = data.frame(a=c(-3,11,13), b = c(50, -2, 34), c = c(1681,169,625))
nls(c~(x-a)^2 + (y-b)^2, data = dt, start = list(x = 1, y = 1))
but getting an error all the time. (and yes I already tried changing the max iteration)
Error in nls(c ~ (x - a)^2 + (y - b)^2, data = dt, start = list(x = 1, :
number of iterations exceeded maximum of 50
how do you solve the root values in R?
nls does not work with zero residual data -- see ?nls where this is mentioned. nlxb in the nlmrt package is mostly similar to nls in terms of input arguments and does support zero residual data. Using dt from the question just replace nls with nlxb:
library(nlmrt)
nlxb(c~(x-a)^2 + (y-b)^2, data = dt, start = list(x = 1, y = 1))
giving:
nlmrt class object: x
residual sumsquares = 2.6535e-20 on 3 observations
after 5 Jacobian and 6 function evaluations
name coeff SE tstat pval gradient JSingval
x 6 7.21e-12 8.322e+11 7.649e-13 -1.594e-09 96.93
y 10 1.864e-12 5.366e+12 1.186e-13 -1.05e-08 22.45
You cannot always solve three equations for two variables.You can solve two equations for two variables and test if the solution satisfies the third equation.
Use package nleqslv as follows.
library(nleqslv)
f1 <- function(z) {
f <- numeric(2)
x <- z[1]
y <- z[2]
f[1] <- (x+3)^2 + (y-50)^2 - 1681
f[2] <- (x-11)^2 + (y+2)^2 - 169
f
}
f2 <- function(z) {
x <- z[1]
y <- z[2]
(x-13)^2 + (y-34)^2 - 625
}
zstart <- c(0,0)
z1 <- nleqslv(zstart,f1)
z1
f2(z1$x)
which gives you the following output:
>z1
$x
[1] 6 10
$fvec
[1] 7.779818e-09 7.779505e-09
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 9
$njcnt
[1] 1
$iter
[1] 9
>f2(z1$x)
[1] 5.919242e-08
So a solution has been found and the solution follows from the vector z$x. Inserting z$x in function f2 also gives almost zero.
So a solution has been found.
You could also try package BB.
Just go through rootSolve package and you will be done:
https://cran.r-project.org/web/packages/rootSolve/vignettes/rootSolve.pdf
Intro: I sucessfully use the rSymPy library to symbolically solve following example system of equalities.
x + y = 20; x + 2y = 10
library(rSymPy)
sympy("var('x')")
sympy("var('y')")
sympy("solve([
Eq(x+y, 20),
Eq(x+2*y, 10)
],
[x,y])")
# output
#[1] "{x: 30, y: -10}"
Use case: In my use case I want to symbolically solve a system of a mixed system of equality and inequality. Here's a reproduceable example:
x + y = 20; x + 2y > 10
The inequality can be sucessfully coded in rSymPy with Gt:
sympy("Gt(x+2*y, 10)")
# output
# [1] "10 < x + 2*y"
Problem: The code of the mixed system throughs an error:
sympy("solve([
Eq(x + y, 20),
Gt(x+2*y, 10)
],
[x,y])")
# output
# Error in .jcall("RJavaTools", "Ljava/lang/Object;", "invokeMethod", cl, :
# Traceback (most recent call last):
# File "<string>", line 1, in <module>
# File "/Users/.../R/3.0/library/rSymPy/Lib/sympy/solvers/solvers.py", line 308, in solve
# raise NotImplementedError()
# NotImplementedError
Question: How can I refactor the code successfully to solve the mixed system?
1) Define a positive variable z. Then the system can be recast as a system of equalities in terms of z:
x <- Var('x')
y <- Var('y')
z <- Var('z')
sympy("solve( [ Eq(x+y, 20), Eq(x + 2*y - z, 10) ], [x, y] )")
giving:
[1] "{x: 30 - z, y: -10 + z}"
2) This is a linear programming problem so if you are just looking for any feasible solution to the constraints then the lpSolve package can provide such. In this case it gives the solution corresponding to z=10 in (1):
library(lpSolve)
out <- lp(, c(0, 0), matrix(c(1, 1, 1, 2), 2), c("=", ">"), c(20, 10))
out$solution
## [1] 20 0
ADDED first solution in response to comment from poster. Added some further discussion.
It looks like NotImplmentedError is coming form SymPy itself. It looks like it can't solve multivariate inequalities. It can only reduce them (which is what your example did). It doesn't appear that the library supports that type of system.
def _solve_inequality(ie, s, assume=True):
""" A hacky replacement for solve, since the latter only works for
univariate inequalities. """
if not ie.rel_op in ('>', '>=', '<', '<='):
raise NotImplementedError
expr = ie.lhs - ie.rhs
try:
p = Poly(expr, s)
if p.degree() != 1:
raise NotImplementedError
except (PolynomialError, NotImplementedError):
try:
n, d = expr.as_numer_denom()
return reduce_rational_inequalities([[ie]], s, assume=assume)
except PolynomialError:
return solve_univariate_inequality(ie, s, assume=assume)
a, b = p.all_coeffs()
if a.is_positive:
return ie.func(s, -b/a)
elif a.is_negative:
return ie.func(-b/a, s)
else:
raise NotImplementedError
In the meantime I discovered the excellent LIM package which nicely allows symbolical solution to various kinds of linear inverse problems:
The ASCII file linprog.lim contains the symbolical problem in a human readable form (it's located in the same directory as the R code):
## UNKNOWNS
X
Y
## END UNKNOWNS
## EQUALITIES
X + Y = 20
## END EQUALITIES
## INEQUALITIES
X + 2 * Y > 10
## END INEQUALITIES
## PROFIT
X + Y
## END PROFIT
Following R code provides the solution to the linear programming problem:
require(LIM)
model= Setup("linprog.lim")
model.solved= Linp(model, ispos=F, verbose=T)
model.solved
Output:
$residualNorm
[1] 3.552714e-15
$solutionNorm
[1] 20
$X
X Y
[1,] 20 0
Here's another approach using the Rglpk library which can read in and solve GNU's MathProg scripted problems in R:
# in case CRAN install does not work
install.packages("Rglpk", repos="http://cran.us.r-project.org")
library(Rglpk)
## read file
x= Rglpk_read_file("mathprog1.mod", type = "MathProg", verbose=T)
## optimize
Rglpk_solve_LP(obj= x$objective,
mat= x$constraints[[1]],
dir= x$constraints[[2]],
rhs= x$constraints[[3]],
bounds= x$bounds,
types= x$types,
max= x$maximum)
File mathprog1.mod:
# Define Variables
var x;
var y;
# Define Constraints
s.t. A: x + y = 20;
s.t. B: x + 2*y >= 10;
# Define Objective
maximize z: x + y;
# Solve
solve;
end;
R console output:
# $optimum
# [1] 20
# $solution
# [1] 0 20
# $status
# [1] 0
Simple one here, i once knew this but it has been lost over the years.
Simple equation easy to code in R:
f(x,y) = 2x^2 + 4y^2 + 6x - 8y + 15
And i have constraints of x > 1 and y > -1.
I cant for the life of me remember how to write the constraints properly in R and the book i have is no use
Cheers for any help
Looking for the minimum and maximum
Define your function that takes a single vector of arguments:
myfun <- function(xy) {
x <- xy[1]
y <- xy[2]
2*x^2 + 4*y^2 + 6*x - 8*y + 15
}
Supply starting values to optim and specify your lower bounds for x and y:
starting_values <- c(0, 0)
optim(starting_values, myfun, lower=c(1, -1), method='L-BFGS-B')
optim output:
$par
[1] 1 1
$value
[1] 19
$counts
function gradient
2 2
$convergence
[1] 0
$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"