I need to solve the following function for P and K:
I would like to find all (or a handful) of P's and K's that satisfy the equation.
I have tried using R's nleqslv package, but something is going wrong.
MPK<-function(X){
Y=numeric(2)
Y[1] = 4.34783*((.3*(X[1]^.23)+.7*(X[2]^.23))^3.34783)*0.069*(X[1]^-.77)
Y[2] = 0.3*((1-X[2])/(1-X[1]))^.7
Y
}
#solve for K, P
xstart = c(.5,.5)
nleqslv(x = xstart,fn = MPK)
What I get is the following:
$x
[1] 1.214578e+10 1.006411e+00
$fvec
[1] 5.531138e-03 7.636165e-10
$termcd
[1] 5
$message
[1] "Jacobian is too ill-conditioned (1/condition=8.9e-013) (see
allowSingular option)"
$scalex
[1] 1 1
$nfcnt
[1] 142
$njcnt
[1] 7
$iter
[1] 70
How do I specify that I need solutions where Y1 is equal to Y[2]?
Related
I am trying to compute this integral in R:
I found three functions which can be used for this and they are all giving me different results. Here is the code:
integrand <- function(x){
r <- 1/x
return(r)
}
First is the option from base R:
integrate(integrand,-Inf, Inf)
Giving the result:
0 with absolute error < 0
The second is from the pracma package:
quadinf(integrand, -Inf, Inf)
Giving this output:
$Q
[1] -106.227
$relerr
[1] 108.0135
$niter
[1] 7
And the last one is from the cubature package:
cubintegrate(integrand, -Inf, Inf)
Which gives the following result:
$integral
[1] Inf
$error
[1] NaN
$neval
[1] 15
$returnCode
[1] 0
So then, which one of these is correct and which should I trust? Is it 0, infinity, or -106.227? Why are they all different in the first place?
1/x isn't integrable in [-Inf,Inf] range, because not integrable in 0.
On an integrable range, results are similar:
integrate(\(x) 1/x,1,2)
#0.6931472 with absolute error < 7.7e-15
pracma::quadinf( \(x) 1/x,1,2)
#$Q
#[1] 0.6931472
#$relerr
#[1] 7.993606e-15
#$niter
#[1] 4
Note that integral of 1/x in ]0,Inf] range is log(x):
log(2)-log(1)
#[1] 0.6931472
#attempt
optim(c(0.1,0.1),
function(x){x[1]^2*0.05126875+2*((x[1]*x[2])*-0.00809375)+x[2]^2*0.03376875})
How to create a function that generates values from 0.01 to 1 for x [1] and x [2], and returns me what was the lowest result with the condition of x [1] + x [2] = 1?
When you have a constrain and still want to use optim, you can reformulate your constrained optimization problem, e.g.,
optim(0.1,
function(x) x^2*0.05126875+2*((x*(1-x))*-0.00809375)+(1-x)^2*0.03376875,
lower = 0,
upper = 1,
method = "L-BFGS-B")
which gives
$par
[1] 0.4135589
$value
[1] 0.01645614
$counts
function gradient
4 4
$convergence
[1] 0
$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
For your case, the solution is
x1 = 0.4135589
x2 = 1-x1
x = c(x1,x2)
> x
[1] 0.4135589 0.5864411
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'm trying to set up a "Solver" function to optimize the value of "gfc" to zero varying (and finding) the variable "fc" on equation below. The parameters are given.
f0 = 6
f1 = 1
k = 2
ft = 0.3
gfc = ft-((f0-fc)/k)+((f1/k)*ln((fc-f1)/(f0-f1)))
Solving this function on Excel, I found the value of fc=5.504.
You can use uniroot to find where a function equals zero:
f0 = 6
f1 = 1
k = 2
ft = 0.3
gfc = function(fc) {
ft - ((f0 - fc) / k) + ((f1 / k) * log((fc - f1) / (f0 - f1)))
}
uniroot(gfc, interval = c(f0, f1))
#> $root
#> [1] 5.504386
#>
#> $f.root
#> [1] 6.72753e-09
#>
#> $iter
#> [1] 5
#>
#> $init.it
#> [1] NA
#>
#> $estim.prec
#> [1] 6.103516e-05
I assume that what you mean is that you want to solve for the value of fc for which gfc equals zero. We assume fc lies between f0 and f1. In that case using the constants in the question we have the following base R solutions. (Additionally packages with such functionality include nleqslv and rootSolve.)
1) optimize we can minimize gfc^2:
gfc <- function(fc) ft-((f0-fc)/k)+((f1/k)*log((fc-f1)/(f0-f1)))
optimize(function(x) gfc(x)^2, c(f0, f1))
giving:
$minimum
[1] 5.504383
$objective
[1] 4.777981e-12
2) uniroot or we can do it directly using uniroot:
u <- uniroot(gfc, c(f0, f1))
giving:
> u
$root
[1] 5.504386
$f.root
[1] 6.72753e-09
$iter
[1] 5
$init.it
[1] NA
$estim.prec
[1] 6.103516e-05
3) We can also solve this directly without any function like optimize or uniroot by rewriting
gfc(fc) = 0
as this where we have moved the first term of gfc to the LHS and then isolated fc in that term putting everything else on the RHS.
fc = f0 - k*(ft + ((f1/k)*log((fc-f1)/(f0-f1))))
Writing this as:
fc = f(fc)
we just iterate f.
f <- function(fc) f0 - k*(ft + ((f1/k)*log((fc-f1)/(f0-f1))))
fc <- (f0 + f1)/2 # starting value
for(i in 1:10) fc <- f(fc)
fc
## [1] 5.504386
4) brute force Another approach is to evaluate gfc at many points and just pick the one for which gfc^2 is least. The finer you subdivide the interval the more accurate the answer.
s <- seq(f0, f1, length = 100000)
g <- gfc(s)
s[which.min(g^2)]
## [1] 5.504395
Graphics
We can show the solution:
curve(gfc, f0, f1)
abline(h = 0, v = u$root, lty = 2)
axis(1, u$root, round(u$root, 3))
I´m trying to solve this system with package nleqsl, but I´m not succeeding. Can someone help me?
require(nleqslv)
fun<-function(x, E1, V1, E2,V2) {
y <- rep(NA, length(x))
y[1]=E1-(x[1]/x[2]+x[4]*x[1]/x[2]^3)
y[2]=V1-(x[3]/x[2]^2+x[4]*x[1]^2/x[2]^4)
y[3]=E2-(x[2]/x[1]+x[3]*x[2]/x[1]^3)
y[4]=V2-(x[4]/x[1]^2+x[3]*x[2]^2/x[1]^4)
return(y)
}
E1=2.08
V1=0.2
E2=0.505
V2=0.0125
xstart <- c(1, .9, 1,.9)
nleqslv(xstart, fun, E1=E1,V1=V1,E2=E2,V2=V2)
Expected answer: x=c(10,5,1,1)
Answer:
$x
[1] 13384651 12046186 26769295 24092367
$fvec
[1] 0.96888871 0.19999961 -0.39500014 0.01249974
$termcd
[1] 5
$message
[1] "Jacobian is too ill-conditioned (1/condition=4.7e-018) (see allowSingular option)"
$scalex
[1] 1 1 1 1
$nfcnt
[1] 1
$njcnt
[1] 1
$iter
[1] 2
Thanks in advance!