How to solve a non-linear equation using nleqslv package in R? - r

I have this equation to solve (e.g. f(x,y) = 0):
library(nleqslv)
target <- function(x)
{
z = x[1]/(x[1]+x[2])
y = numeric(2)
y[1] <- z*exp(-x[2]*(x[2]+z*(1-exp(-x[1]/z))))-0.00680
y[2] <- z/x[2]*(1-exp(-x[2]))-exp(-x[2])*z/x[1]*(1-exp(-x[1]))-3.43164
y
}
# Usage
xstart <- c(1,1)
target(xstart)
nleqslv(xstart, target, control=list(ftol=.0001, allowSingular=TRUE),jacobian=TRUE,method="Newton")
using R with nleqslv or another you have others :)
Thanks

I have been experimenting with your function. Rewrite the target function to use the a;b constants in your comment as in your second comment as follows:
target <- function(x, a=.00680,b=3.43164)
{
z <- x[1]/(x[1]+x[2])
y <- numeric(2)
y[1] <- z*exp(-x[2]*(x[2]+z*(1-exp(-x[1]/z))))-a
y[2] <- z/x[2]*(1-exp(-x[2]))-exp(-x[2])*z/x[1]*(1-exp(-x[1]))-b
y
}
The default values for a and b are what you initially specified.
Using them you'll get an ill-conditioned jacobiam.
However if we give some other values to a and b for example like so
nleqslv(xstart, target, control=list(btol=.01),jacobian=TRUE,method="Newton",a=2,b=1)
or
nleqslv(xstart, target, control=list(btol=.01),jacobian=TRUE,method="Newton",a=2,b=2)
then for the first expression the full return value of nleqslv is
$x
[1] 2.4024092 -0.7498464
$fvec
[1] 1.332268e-15 2.220446e-16
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 10
$njcnt
[1] 7
$iter
[1] 7
$jac
[,1] [,2]
[1,] -0.2930082 -1.2103174
[2,] 0.1801120 -0.6566861
I am inclined to conclude that either your function is incorrect or that you have specified impossible values for a and b. Method Broyden also seems to work nicely.

Related

Finding root of an Integral equation with no closed form in R

I have a function f(x) with a free constant S. Once I integrate the function f(x) from 0 to infinity I would like to approximate what value of S makes the integral equal 1.
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {integrate(integrand,lower=0,upper=Inf)-1}
#trying to find the root of function
uniroot(intfun, lower = 0, upper = 1)
I also tried:
uniroot(integrate(integrand,lower=0,upper=Inf)-1, lower = 0, upper = 1)
Error given:
Error in f(x, ...) : object 'S' not found
The S value I am looking for is near 0.564029.
You should change your function:
a <-0.3 #alpha
b <- 2.5 #beta
d <-0.7 #delta
g <-1.1 #gamma
#defining the function, note S is free (which causes an error, pasted below)
integrand <- function(x, S) {b*g/d*exp(-g*x)*(1-exp(-d* x))*exp(-a*b*S/d*(1-exp(-d*x)))}
#defining the integral equation I would like to solve for S
intfun<- function(S) {
integrate(function(x)integrand(x, S),lower=0,upper=Inf)[[1]]-1
}
uniroot(intfun,c(-1,1))
$root
[1] 0.564041
$f.root
[1] -6.961327e-06
$iter
[1] 6
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05

Sum function in the R programming

In R , I have a vector like x= 3:100
I want to write function like:
sum ( (x/a)^2t) - 5
and get the answer if I choose any value for t .
Example:
Func= function ( t ) {
x=c(1:100)
a= min(x)
Sum ( x / a )^2t - 5
}
I don't know if this correct or not.
what about if I want to get the root of the function by secant method. I use library(NLRoot) in R. but the codes that I write it is not correct.
library(NLRoot)
curve(func, xlim=c(0,3), col='blue', lwd=1.5, lty=2,xlab="x",ylab="f(x)")
output is written Error in code.
Here is just a syntax correction
Func <- function(t) {
x <- c(1:100)
a <- min(x)
sum((x / a)^(2 * t)) - 5
}
and a more compact version might be something like below
Func <- function(t, x = 1:100) sum((x / min(x))^(2 * t)) - 5
To find the root, thanks for comments from #Rui Barradas, we can use uniroot, i.e.,
> uniroot(Func, interval = c(-5, 5))
$root
[1] -0.5091492
$f.root
[1] -0.0003913713
$iter
[1] 13
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05

How to solve a nonlinear equation in R with a constant of a list of values?

I use nleqslv to solve a nonlinear equation in R. The constant b is a list of values from "21.csv". There are 10137 values of b, so I want to get 10137 roots of this function (10137 values of x). Why the result of x has only one value (the length of x is 1)? Is there anything wrong with the code, and how to get the list of 10137 values of x with the 10137 b(s)? Thanks
a=read.csv("21.csv",header=TRUE)
b=c(a$c)
library(nleqslv)
target= function(x, a=1.239448)
{
y = numeric(1)
y[1] = -a*(1+exp(a*x[1]-b))^(-2)*exp(a*x[1]-b)*x[1]-a+b
y
}
xstart = c(10)
target(xstart)
nleqslv(xstart, target, control=list(ftol=.0001, allowSingular=TRUE),jacobian=TRUE,method="Newton")
>
$x
[1] 9.68385
> head(a)
c
1 11.83898
2 11.72014
3 14.86955
4 18.20404
5 17.69610
6 17.51668
> head(b)
[1] 11.83898 11.72014 14.86955 18.20404 17.69610 17.51668
As I mentioned in my comment your function target is always returning a scalar and xstart is a scalar.
If b is a vector then you should rewrite target, return a vector and provide a starting value of appropriate length.
See the following.
Write the target function as follows as a function of a vector x and returning a vector
target <- function(x, a=1.239448)
{
y <- numeric(length(x))
y <- -a*(1+exp(a*x-b))^(-2)*exp(a*x-b)*x-a+b
y
}
Create some fake data for b and set some values for xstart
b <- c(1.5,1.6)
xstart <- c(1,2)
nleqslv(xstart, target, control=list(ftol=.0001, allowSingular=TRUE),jacobian=TRUE,method="Newton")
Result is now
$x
[1] 0.8771918 2.9811141
$fvec
[1] 0.000000e+00 2.960259e-08
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 6
$njcnt
[1] 4
$iter
[1] 4
$jac
[,1] [,2]
[1,] -0.3627487 0.0000000
[2,] 0.0000000 0.2279917
Method Broyden also works and the control argument is not needed in this case.

Solve equation using optim()

I have 2 equation that need to be solved by using optim
{(4x^2-20x+1/4 y^2+8=0
1/2 xy^2+2x-5y+8=0)
I have already run the code,but I'm confused if there should be 1 answer or 2 because function will only return the results for the last line
Should I do like this
> myfunc=function(x){
+ 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
and
> myfunc=function(x){
+ (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
or should I do like this
> myfunc=function(x){
+ 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
+ (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
+ }
> optim(c(0,0),myfunc,method="BFGS")
For the second one it still give me only the answer for the second function so which method is correct.
Minimize the sum of the squares of the two expressions that should equal zero and ensure that the value at the optimum equals 0 (up to floating point approximation).
myfunc <- function(z) {
x <- z[1]
y <- z[2]
(4*x^2-20* x + 1/4*y^2 + 8)^2 + (1/2 * x*y^2 + 2*x- 5*y + 8)^2
}
optim(c(0, 0), myfunc)
giving:
$par
[1] 0.5000553 2.0002986
$value
[1] 1.291233e-06
$counts
function gradient
67 NA
$convergence
[1] 0
$message
NULL
You can also use a package for solving systems of non linear equations such as nleqslv.
Slightly redefine your function by making it return a vector containing the result for each equation
myfunc <- function(x){
y <- numeric(length(x))
y[1] <- 4*x[1]^2-20*x[1]+(x[2]^2/4)+8
y[2] <- (1/2)*(x[1]*x[2]^2)+2*x[1]-5*x[2]+8
y
}
Define a starting value for the solver
xstart <- c(0,0)
Then do this
library(nleqslv)
nleqslv(xstart,myfunc)
giving
$x
[1] 0.5 2.0
$fvec
[1] -1.472252e-09 -7.081979e-10
$termcd
[1] 1
$message
[1] "Function criterion near zero"
$scalex
[1] 1 1
$nfcnt
[1] 7
$njcnt
[1] 1
$iter
[1] 7
There are more packages that can solve equation systems such as BB and pracma.

function for solving equation R

I'm trying to solve
$\sum_{j=1}^{180} x^{a_j} = 1$
I created two functions :
f1 <- function(x){c(rep(x,180))}
f2 <- function(x){sum(f1(x)^vec) - 1}
where vec is my a_j vector.
uniroot doesn't work. Which function should I use ?
Is there a better syntax ?
Why doesn't uniroot work, actually? As long as you define correctly your function and the interval to look for it should work:
aj <- c(-4,-5,-3,-4,-2,-3,-1,-2,-7,-6,-5,-8,-7,-6,-6,-7,-5,-6,
-4,-5,-3,-4,-9,-8,-7,-10,-9,-8,-1,-2,rep(-1,150))
f <- function(x,vec){sum(x^vec)-1}
uniroot(f, interval=c(-100,100), vec=aj)
$root
[1] -0.518658
$f.root
[1] -0.009276057
$iter
[1] 21
$estim.prec
[1] 6.103516e-05
You can use polyroot, For example
polyroot(c(-1,rep(1,180)))
here
p(x) = -1 + 1 * x + … + 1 * x^180
EDIT To use your vector aj
It is not clear what is your vector vec , I guess you want something like this :
polyroot(c(-1,vec))
Where vec
vec = (a1,a2,..............,a180)
EDIT after OP clarification:
The OP wants to find the roots of polynome with negative exponents. The solution is to factorize by the max of the exponents to can apply polyroot.
vec <- c(-4,-5,-3,-4,-2,-3,-1,-2,-7,-6,-5,-8,-7,-6,-6,-7,-5,-6,
-4,-5,-3,-4,-9,-8,-7,-10,-9,-8,-1,-2,rep(-1,150))
ma <- max(abs(vec))
vec <- sort(ma+vec)
polyroot(as.data.frame(table(vec))$Freq)

Resources