Solve equation using optim() - r

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.

Related

Find maximum value for x for a polynomial function

I am using a simple polynomial to fit a curve.
poly <- function(a, b, c, x) a * x^2 + b * x + c
I'd like to find the value of x that results in the maximum value of the curve. Currently I create a grid with a range of x from 20000 to 50000, run the function for each row, then use max() on the result. It works, but I have a lot of groups and it creates a big dataframe every time I do it. It is very clunky and I feel like there must be a better way.
Some typical coefficients are:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
If you rearrange your function so the variable you want to maximize is first and you set the default values like so:
poly <- function(x, a, b, c) a * x^2 + b * x + c
formals(poly)$a <- -0.000000179
formals(poly)$b <- 0.011153167
formals(poly)$c <- 9.896420781
Then you can use the optimize function to maximize over your interval:
optimize(poly, c(20000, 50000), maximum = T)
$`maximum`
[1] 31154.1
$objective
[1] 183.6298
Where $maximum is the x value at which the maximum occurs and $objective is the height.
If a is negative, maximum of parabola a * x^2 + b * x + c is reached at -b/(2*a) :
a<0
#[1] TRUE
-b/(2*a)
#[1] 31154.1
You could use optim. I think the other solutions answered in this thread are more appealing, but I'll write this up for completeness:
a <- -0.000000179
b <- 0.011153167
c <- 9.896420781
o <- optim(
par=list(x=0),
fn=function(x){ -poly(a,b,c,x=x) },
method="Brent",
lower=-50e3, upper=50e3
)
Output:
> o
$par
[1] 31154.1
$value
[1] -183.6298
$counts
function gradient
NA NA
$convergence
[1] 0
$message
NULL

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.

How to solve a non-linear equation using nleqslv package in 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.

Optimize function with nlm and optim

I have the following function
f <- function(a,b) {
(a - 1) + 3.2/b + 3*log(gamma(a)) + 3*a*log(b);
}
I want to optimized this function with nlm() ,optim() ect....
I am trying to do that with:
value <- nlm(f,optim(f))
However, I get an error message.cannot coerce type 'closure' to vector of type 'double' I really would appreciate your answer!
It works ok for me using both optim and nlm. I did a little modification
f <- function(par) {
a <- par[1]
b <- par[2]
(a - 1) + 3.2/b + 3*log(gamma(a)) + 3*a*log(b);
}
> optim(c(1, .3), fn=f)
$par
[1] 1.399685 0.762025
$value
[1] 3.09904
$counts
function gradient
55 NA
$convergence
[1] 0
$message
NULL
> nlm(f, c(1,.3))
$minimum
[1] 3.09904
$estimate
[1] 1.3999515 0.7619307
$gradient
[1] 3.096044e-07 3.907985e-07
$code
[1] 1
$iterations
[1] 17

Resources