We have a function. t ~ Weibull(alpha, lambda) and c ~ Exponential(beta):
Given p = 0.10, alpha = 1, lambda = 4. Find the value of beta.
We want to integrate this function for t then to c. Then find the value of beta where integral equals to p using uniroot function.
See the code below:
alpha = 1
lambda = 4
p = 0.10
func1 <- function(t, c, beta) {alpha * lambda * exp(-lambda * t^ alpha)*
beta * exp(- beta * c) }
func2 <- function(c, beta){integrate(func1, lower = c, upper = Inf, c=c,
beta=beta)}
func3 <- function(beta){integrate(func2, lower = 0, upper = Inf, beta =
beta)$value - cen.p}
uniroot(func3 ,lower = 0.001, upper = 10, extendInt = "yes")$root
However it throws the error:
Error in integrate(func1, lower = c, upper = Inf, c = c, beta = beta)
: length(lower) == 1 not TRUE
Answer should be 0.444
I corrected typos (substituted cen.p to p) and vectorized function arguments for func2 and func3, since the integrate function returns one value (scalar). However as a first argument integrate should accept vector of numeric values, not a scalar.
alpha <- 1
lambda <- 4
p <- 0.10
func1 <- function(t, c, beta)
alpha * lambda * t^(alpha - 1) * exp(-lambda * t^alpha) * beta * exp(-beta * c)
func2 <- function(c, beta)
integrate(func1, lower = c, upper = Inf, c = c, beta = beta)$value)
func3 <- function(beta)
integrate(Vectorize(func2), lower = 0, upper = Inf, beta = beta)$value - p
uniroot(Vectorize(func3), lower = 0.001, upper = 10, extendInt = "yes")$root
Output:
[1] 0.4444242.
Related
I am new to R. I want to do some parameters estimation by using Maximum Likelihood Estimation.
Here is my attempt:
The data are
my_data = c(0.1,0.2,1,1,1,1,1,2,3,6,7,11,12,18,18,18,18,18,21,32,36,40,
45,45,47,50,55,60,63,63,67,67,67,67,72,75,79,82,82,83,
84,84,84,85,85,85,85,85,86,86)
and
lx <- function(p,x){
l <- p[1]
b <- p[2]
a <- p[3]
n <- length(x)
lnL <- n*log(l)+n*log(b)+n*log(a)+(b-1)*sum(log(x))+(a-1)*sum(log(1+l*x^b))+n-sum(1+l*x^b)
return(-lnL)
}
Note: l is λ, b is β, and a is α.
And here is the optim function
optim(p=c(1,1,1),fn = lx, method = "L-BFGS-B",
lower = c(0.0001, 0.0001, 0.0001),
control = list(), hessian = FALSE, x = my_data)
After I run this code, I get an error message:
Error in optim(p = c(1, 1, 1), fn = lx, method = "L-BFGS-B", lower = c(1e-04, :
objective function in optim evaluates to length 50 not 1
What's wrong with my code? Can you help me to fix it? Thanks in advance!
Instead of a log-likelihood, use MASS::fitdistr.
#
# Power Generalized Weibull distribution
#
# x > 0, alpha, beta, lambda > 0
#
dpowergweibull <- function(x, alpha, beta, lambda){
f1 <- lambda * beta * alpha
f2 <- x^(beta - 1)
f3 <- (1 + lambda * x^beta)^(alpha - 1)
f4 <- exp(1 - (1 + lambda * x^beta)^alpha)
f1 * f2 * f3 * f4
}
ppowergweibull <- function(q, alpha, beta, lambda){
1 - exp(1 - (1 + lambda * q^beta)^alpha)
}
my_data <- c(0.1,0.2,1,1,1,1,1,2,3,6,7,11,12,18,18,18,18,18,21,32,36,40,
45,45,47,50,55,60,63,63,67,67,67,67,72,75,79,82,82,83,
84,84,84,85,85,85,85,85,86,86)
start_par <- list(alpha = 0.1, beta = 0.1, lambda = 0.1)
y1 <- MASS::fitdistr(my_data, dpowergweibull, start = start_par),
start_par2 <- list(shape = 1, rate = 1)
y2 <- MASS::fitdistr(my_data, "gamma", start = start_par2)
hist(my_data, freq = FALSE)
curve(dpowergweibull(x, y1$estimate[1], y1$estimate[2], y1$estimate[3]),
from = 0.1, to = 90, col = "red", add = TRUE)
curve(dgamma(x, y2$estimate[1], y2$estimate[2]),
from = 0.1, to = 90, col = "blue", add = TRUE)
Assume the following is defined in the global environment:
theta = .9
sigma = .2
x0 = .7
mu = 12
I have the following function which contains the result of an integral:
f <- function(x){
g <- function(t){
2*mu*(theta - t)/(sigma^2)
}
return(exp(integrate(g, lower = x0, upper = x)$value))
}
When I try to integrate the function:
integrate(f, lower = -1, upper = 1)
I get the following error:
Error in integrate(g, lower = x0, upper = x) :
'upper' must be of length one
Why is this happening?
You may need to vectorize your values for upper, e.g., using sapply like below
f <- function(x) {
g <- function(t) {
2 * mu * (theta - t) / (sigma^2)
}
sapply(x, function(v) exp(integrate(g, lower = x0, upper = v)$value))
}
or Vectorize
f <- function(x) {
g <- function(t) {
2 * mu * (theta - t) / (sigma^2)
}
Vectorize(function(v) exp(integrate(g, lower = x0, upper = v)$value))(x)
}
such that
> integrate(f, lower = -1, upper = 1)
16536 with absolute error < 0.016
I am trying to solve a minimization problem in R with nlminb as part of a statistical problem. However, there is something wrong when comparing the solution provided by nlminb with the plot of the function I am trying to minimize. This is the R-code of the objective function
library(cubature)
Objective_Function <- function(p0){
F2 <- function(x){
u.s2 <- x[1]
u.c0 <- x[2]
u.k0 <- x[3]
s2 <- u.s2^(-1) - 1
c0 <- u.c0^(-1) - 1
k0 <- u.k0/p0
L <- 1/2 * c0 * s2 - 1/c0 * log(1 - k0 * p0)
A <- 1 - pnorm(L, mean = 1, sd = 1)
A <- A * dgamma(k0, shape = 1, rate = 1)
A <- A * dgamma(c0, shape = 1, rate = 1)
A <- A * dgamma(s2, shape = 1, rate = 1)
A * u.s2^(-2) * u.c0^(-2) * 1/p0
}
Pr <- cubature::adaptIntegrate(f = F2,
lowerLimit = rep(0, 3),
upperLimit = rep(1, 3))$integral
A <- 30 * Pr * (p0 - 0.1)
B <- 30 * Pr * (1 - Pr) * (p0 - 0.1)^2
0.4 * B + (1 - 0.4) * (-A)
}
Following the R-command
curve(Objective_Function, 0.1, 4)
one observes a critical point close to 2. However, when one executes
nlminb(start = runif(1, min = 0.1, max = 4),
objective = Objective_Function,
lower = 0.1, upper = 4)$par
the minimum of the function takes place at the point 0.6755844.
I was wondering if you could tell me where my mistake is, please.
Is there any reliable R-command to solve optimization problems?
If this is a very basic question, I apologize.
Thank you for your help.
The problem is not nlminb() but the fact that you have not provided a vectorized function in curve(). You can get the correct figure using the following code, from which you see that nlminb() indeed finds the minimum:
min_par <- nlminb(start = runif(1, min = 0.1, max = 4),
objective = Objective_Function,
lower = 0.1, upper = 4)$par
vec_Objective_Function <- function (x) sapply(x, Objective_Function)
curve(vec_Objective_Function, 0.1, 4)
abline(v = min_par, lty = 2, col = 2)
In addition, for univariate optimization you can also use function optimize(), i.e.,
optimize(Objective_Function, c(0.1, 4))
I am working with a function that depends on quadratic B-spline interpolation estimated up front by the the cobs function in the same R package. The estimated knots and corresponding coefficients are given in code.
Further on, I require the integral of this function from 0 to some value, for example 0.6 or 0.7. Since my function is strictly positive, the integral value should increase if the upper bound of the integral increases. However this is not the case for some values, as shown when using 0.6 and 0.7
library(cobs)
b <- 0.6724027
xi1 <- 0.002541667
xi2 <- 2.509625
knots <- c(5.000010e-06, 8.700000e-05, 3.420000e-04, 1.344000e-03, 5.292000e-03, 2.082900e-02, 8.198800e-02, 3.227180e-01, 1.270272e+00, 5.000005e+00)
coef <- c(2.509493, 2.508141, 2.466733, 2.378368, 2.239769, 2.063977, 1.874705, 1.601780, 1.288163, 1.262683, 1.432729)
fn <- function(x) {
z <- (2 - b) * (cobs:::.splValue(2, knots, coef, x, 0) - 2 * x * xi1) / xi2 - b
return (z)
}
x <- seq(0, 0.7, 0.0001)
plot(x, fn(x), type = 'l')
integrate(f = fn, 0, 0.6)
# 0.1049019 with absolute error < 1.2e-15
integrate(f = fn, 0, 0.7)
# 0.09714124 with absolute error < 1.1e-15
I know I could integrate directly on the cobs:::.splValue function, and transform the results correspondingly. However, I am interested to know why this strange behaviour occurs.
I think that the algorithm used by the function "integrate" is not behaving well for those conditions. For example, if you modify the lower limits, it works as expected:
> integrate(f = fn, 0.1, 0.6)
0.06794357 with absolute error < 7.5e-16
> integrate(f = fn, 0.1, 0.7)
0.07432096 with absolute error < 8.3e-16
This is common with numerical integration methods, you have to choose on a case by case basis.
I'm using the trapezoidal rule to integrate over the same region and works well original code
composite.trapezoid <- function(f, a, b, n) {
if (is.function(f) == FALSE) {
stop('f must be a function with one parameter (variable)')
}
h <- (b - a) / n
j <- 1(:n - 1)
xj <- a + j * h
approx <- (h / 2) * (f(a) + 2 * sum(f(xj)) + f(b))
return(approx)
}
> composite.trapezoid(f = fn, 0, 0.6, 10000)
[1] 0.1079356
> composite.trapezoid(f = fn, 0, 0.7, 10000)
[1] 0.1143195
If we analyze the behavior of the integral close to the 0.65 region, we can see that there is a problem with the first approach (it is not smooth):
tst = sapply(seq(0.5, 0.8, length.out = 100), function(upper) {
integrate(f = fn, 0, upper)[[1]]
})
plot(seq(0.5, 0.8, length.out = 100), tst)
and that the trapezoid rule behaves better:
tst2 = sapply(seq(0.5, 0.8, length.out = 100), function(upper) {
composite.trapezoid(f = fn, 0, upper, 10000)[[1]]
})
plot(seq(0.5, 0.8, length.out = 100), tst2)
I have a big deal with an optimization problem.
I have got a time series of a stock and a transformation function:
K_z <- function(z, theta, beta_z, n) {
z*((1+((z^2+0.5)^beta_z-0.5^ beta_z)/n)^(n*theta))
}
K_fd_z <- function(z, theta, beta_z, n) {
( (1+( (z^2+0.5)^beta_z - 0.5^beta_z)/n)^n )^(theta-1) * ( ( (1+( (z^2+0.5)^beta_z - 0.5^beta_z)/n)^n ) + theta * z * (2*beta_z * z * (1 + ( (z^2+0.5)^beta_z - 0.5^beta_z)/n)^(n-1) * ( z^2+0.5)^(beta_z-1) ) )
}
where: y is the stock
y <- get.hist.quote("ALV", quote="Adj", start="2000-01-01",end="2014-12-31", retclass="zoo")
y <- na.locf(y)
y <- diff(log(y))
y <- exp(y)-1
theta, beta_z, n are parameters and z is
z <- rnorm(length(y), mean = 0, sd = 1)
Now I need this inverse function:
K_inv <- function(y)
{
uniroot(function(z) K_z(z, theta, beta_z, n)-y , lower=9,upper=11)$root
}
K_inverse <- Vectorize(K_inv, "y")
the uniroot should be:
K_m1 <- K_inverse(y)
and this function should be analyzed:
f_Y <- function(z, theta, n, beta_z)
{
K_m1 <- K_inverse(y)
(dnorm(K_m1))/( K_fd_z(K_m1))
}
# curve(f_Y(x,theta=0.2,n=5,beta_z=0.5),-10,10)
#Error in uniroot(function(z) K_z(z, theta, beta_z, n) - y,lower = 9, :
#f() values at end points not of opposite sign
Parameter optimization and boundaries could be something like:
p3 <- optim(c(-0.2, mean(y)-0.2, 0.01, 1, 0.4), loglike, NULL, method = "L-BFGS-B",lower = c(-0.2, mean(y)-0.2, 0.01, 1, 0.4), upper = c(0.2, mean(y)+0.2, 0.5, 250, 1.8)
oi3<-solve(p3$hessian)
It doesn't work...I am quite new in R and don't understand my errors,maybe somebody is able to help me?!?
Thank You in advance...