Excuse me. In optim function, how can I set the boundary for the par[1], par[2], par[3] under MLE?
I have tried the code below, it does not work and my method is not L-BFGS-B either.
get dataset
getSymbols("GOOG", from = "2008-06-30", to = "2018-06-30", src = "yahoo")
get the GOOG daily return
goog.daily <- abs(df.goog$daily.returns)
take absolute value
goog.daily <- abs(df.goog$daily.returns)
MOGPD Negative Likelihood
neg_lik <- function(par, data, u) {
xi <- par[1]
sigma <- par[2]
delta <- par[3]
llog <- rep(0, length(data))
for (i in 1:length(data)) {
if (data[i] <= u) { llog[i] <- 0 }
else {
llog[i] <- -log(delta) + ((1+xi)/xi) * log(1+xi*(data[i] - u)/sigma) +
log(sigma) + 2*log(1-(1-delta)*(1+xi*(data[i] - u)/sigma)^(-1/xi))
}
}
return(sum(llog))
}
estimate parameter MOGPD
optim <- optim(c(0.5, 1, 1), neg_lik,
lower=c(0, 0, 0), upper = c(100, 100, 100),
data = goog.daily, u = thresh)
tl;dr add method="L-BFGS-B", as follows:
opt_res <- optim(c(0.5,1,1),neg_lik,
lower=c(0,0,0),
upper=c(100,100,100),
method="L-BFGS-B",
data=goog.daily,u=thresh)
(it's not recommended to call your result "optim"; it will generally work but occasionally will cause lots of confusion)
If you want to impose constraints on the parameters, you have to use method="L-BFGS-B";
the lower and upper arguments only apply in this case. (There are R packages that provide other constrained optimization choices, e.g. nloptr.) From ?optim:
... includes an option for
box-constrained optimization ...
("an" in this case meaning "only one"; emphasis added), and
lower, upper: Bounds on the variables for the ‘"L-BFGS-B"’ method, or
bounds in which to search for method ‘"Brent"’.
(Brent's method is only for single-parameter optimization). This implies (although does not state it explicitly) that these arguments only work for method="L-BFGS-B".
Also, when you run your model with lower and/or upper set you get a warning:
Warning message:
In optim(...) :
bounds can only be used with method L-BFGS-B (or Brent)
Related
I try to run MLE, and get the
Error in if (!all(lower[isfixed] <= fixed[isfixed] & fixed[isfixed] <= :
missing value where TRUE/FALSE needed constantly,
The negative likelihood function
likelihood.normal <- function (mu,sigma,y ){
pdf_yt <- dnorm(y, mu, sigma, log= FALSE)
-sum(log(pdf_yt))
}
The MLE command
library(stats4)
est.normal<-c(est$mean, est$sd)
bound.lower <-est.normal*0.5 # set the lower bound for the method "L-BFGS-B"
bound.upper <-est.normal*2.0 # set the upper bound for the method "L-BFGS-B"
est.mle<-mle(minuslogl =likelihood.normal, start= list(mu = est$mean, sigma = est$sd),method="L-BFGS-B",fixed = list(y= return.log), lower=bound.lower, upper= bound.upper)
If the fixed parameter is removed, the issue is gone. But I need the fixed parameter.
I too came across this error, and I believe it to be due to package dependency issues within the stats4::mle package.
When I submitted the project, I took a functional approach instead. Create a function that generates a function of the parameters with the data already preset as in the following:
logLikelihood.Norm.Function <- function (y) {
logLikelihood.ParamFunc <- function (mu, sigma) {
n <- length(y)
pdf_yt <- dnorm(y, mu, sigma, log = FALSE)
log.likelihood.value <- -sum(log(pdf_yt))
return(log.likelihood.value)
}
return(logLikelihood.ParamFunc)
}
So I just answered a question and as soon as it was answered (correctly I think), the questioner deleted it. So here it is again:
I am new to R and need help getting this function to work. I need to create a function that can find the log of an mgf for any function and return values for the specified t. I've done lots of research and I found a lot of stuff telling me to use Vectorize() and to make sure I'm defining my parameters properly but i still can't seem to get this to work. I would love if someone could help me out!
I need to write a function that returns a numeric vector for natural log of mgf
# I'm using the expression 2*x as an example
# You can use any integrand as long as it is a function of x
logmgf <- function(integrand, upper, lower, t) {
expression <- function(x, t) {
integrand * exp(x * t)
}
integrate <- integrate(expression(x, t), upper, lower)
logmgf <- log(Vectorize(integrate[1]))
return(logmgf)
}
logmgf(2 * x, upper = Inf, lower = 0, t = 0)
asked 2 hours ago
xiong lui
Let's try something more statistically or mathematically sensible, such as an un-normalized Normal distribution, namely the expression: exp(-x^2)
You are trying to create a new expression (actually an R "call") which will be parsed as the product of that expression times exp(x*t), so you need to a) deliver the function a real R language object and b) work with it using functions which will not mangle it. The quote-function will construct an expression that substitute can manipulate at the "language level". The function-function unfortunately will evaluate the "body" argument in a manner that will not honor your symbolic intent, so you need to use the body<- (function) which expects an expression on the right-hand side of the assignment operator. I'm going to leave in some of the debugging print(.) calls that I used to understand where I was going wrong in my earlier efforts:
logmgf <- function(integrand, upper, lower, t) {
expr <- substitute( integrand *exp(x*t), list(integrand=integrand) )
print(expr)
func <- function(x ){} # builds an empty function in x
body(func)<- expr # could have also set an environment
# but in this case using envir=parent.frame() is not appropriate
print(func)
integral <- integrate( func, upper=upper,
# notice need to name the parameters
lower=lower
# else they would be positionally matched
# (and therefore reversed in this case)
)$value
# the integrate fn returns a loist and the numeric part is in $value
logmgf <- log(integral)
}
res <- logmgf(quote(exp(-x^2)), upper = Inf, lower = -Inf, t = 0)
> res
[1] 0.5723649
MGF's are integrated from -Inf to Inf (or for functions with restricted domains only over the x's with defined values).
I wanted to check that I would get the correct answer from a known argument so I added back the proper normalizing constant for a Normal distribution:
mgf <- function(integrand, upper, lower, t) {
expr <- substitute( integrand *exp(x*t), list(integrand=integrand) )
func <- function(x ){}; body(func)<- expr
integral <- integrate( func, upper=upper, lower=lower)$value
}
res <- mgf(quote((1/sqrt(2*pi))*exp(-x^2/2)), upper = Inf, lower = -Inf, t = 0)
res
#[1] 1
I am trying to solve an integral in R. However, I am getting an error when I am trying to solve for that integral.
The equation that I am trying to solve is as follows:
$$ C_m = \frac{{abs{x}}e^{2x}}{\pi^{1/2}}\int_0^t t^{-3/2}e^{-x^2/t-t}dt $$
The code that I am using is as follows:
a <- seq(from=-10, by=0.5,length=100)
## Create a function to compute integration
Cfun <- function(XX, upper){
integrand <- function(x)x^(-1.5)*exp((-XX^2/x)-x)
integrated <- integrate(integrand, lower=0, upper=upper)$value
(final <- abs(XX)*pi^(-0.5)*exp(2*XX)*integrated) }
b<- sapply(a, Cfun, upper=1)
The error that I am getting is as follows:
Error in integrate(integrand, lower = 0, upper = upper) :
the integral is probably divergent
Does this mean I cannot solve the integral ?
Any possible ways to fix this problem will be highly appreciated.
Thanks.
You could wrap the call to Cfun in a try statement
# note using `lapply` so errors don't coerce the result to character
b <- lapply(a, function(x,...) try(Cfun(x, ...), silent = TRUE), upper = 1)
If you wanted to replace the errors with NA values and print a warning that the integration threw an error
Cfun <- function(XX, upper){
integrand <- function(x)x^(-1.5)*exp((-XX^2/x)-x)
int <- try(integrate(integrand, lower=0, upper=upper), silent = TRUE)
if(inherits(int ,'try-error')){
warning(as.vector(int))
integrated <- NA_real_
} else {
integrated <- int$value
}
(final <- abs(XX)*pi^(-0.5)*exp(2*XX)*integrated) }
Edit (facepalm moment)
Your error arises because your function is not defined when t=0 (you divide by t within the integrand).
Cfun <- function(XX, upper){
integrand <- function(x)x^(-1.5)*exp((-XX^2/x)-x)
# deal with xx=0
if(isTRUE(all.equal(XX, 0)){
warning('The integrand is not defined at XX = 0')
return(NA_real_)
}
# deal with other integration errors
int <- try(integrate(integrand, lower=0, upper=upper), silent = TRUE)
if(inherits(int ,'try-error')){
warning(as.vector(int))
integrated <- NA_real_
} else {
integrated <- int$value
}
(final <- abs(XX)*pi^(-0.5)*exp(2*XX)*integrated) }
I wrote a R code to find the minimum of a function using Gradient Descent Method below:
gradient.method <- function(f, grad, init, unit.fac=TRUE, interval=c(-7,10), tol=1e-11, max.iter = 35)
{
newpair <- init
oldpair <- newpair - 1
iter <- 0
while(iter < max.iter & sqrt(sum((newpair - oldpair)^2)) > tol){
iter <- iter + 1
oldpair <- newpair
#Set up the unit vector u
newstep <- if(unit.fac) grad(x)(oldpair)/sqrt(sum(grad(x)(oldpair)**2))
#Get minimum of f(x_0 - step_size*grad(x_0))
value <- function(step_size) oldpair - step_size*newstep
min <- optimize(f(x)(value(step_size)),interval)
#Get new pair of vector x
newpair <- oldpair - min*newstep
}
list(minimum = newpair, value = f(x)(newpair), nsteps = iter)
}
The functions for f and grad are as follows:
f1 <- function(x){
n<-length(x)
function(theta){
-logLike<- 0.5*n*log(theta[2])-(1/(2*theta[2]))*sum((x-theta[1])**2)
}
}
g1 <- function(x){
n <- length(x)
function(theta){
grd1 <- -sum((x - theta[1])*theta[2])
grd2 <- n/(theta[2]) - 0.5*sum(x - theta[1])
}
}
However, I kept getting an error regarding one of my variables: step_size when testing the code. How should I correct the problem? Thanks.
res<-gradient.method(f=f1, grad=g1, init=c(100,100), max.iter=100)
Error in value(step_size) : object 'step_size' not found
The error message is quite clear, you are trying to use variable step_size which has not been defined anywhere. The problem stems from the fact that you aren't using optimize function properly, you should give it the name of your function which is minimized with regards to it's first argument. From help page of optimize (use ?optimize):
f
the function to be optimized. The function is either minimized or
maximized over its first argument depending on the value of maximum.
So you should be using optimize like this:
value <- function(step_size) oldpair - step_size*newstep
fn<-function(step_size) f(x)(value(step_size))
min <- optimize(fn,interval)
Also the variable x is not defined anywhere, and this your functions f1 and g1 look bit weird, for example this is not valid code:
-logLike<- 0.5*n*log(theta[2])-(1/(2*theta[2]))*sum((x-theta[1])**2)
You are trying to assign something to variable called -logLike, but you cannot use - in variable name.
edit:
Check the documentation of optimize on what the function returns:
Value
A list with components minimum (or maximum) and objective which give
the location of the minimum (or maximum) and the value of the function
at that point.
So your variable min contains two elements although you probably need just the value of the minimum in the next line of your code.
I often run JAGS models on simulated data with known parameters. I like the default plot method for mcmc objects. However, I would like to add an abline(v=TRUE_VALUE) for each parameter that is modelled. This would give me a quick check for whether the posterior is reasonable.
Of course I could do this manually, or presumably reinvent the wheel and write my own function. But I was wondering if there is an elegant way that builds on the existing plot method.
Here's a worked example:
require(rjags)
require(coda)
# simulatee data
set.seed(4444)
N <- 100
Mu <- 100
Sigma <- 15
y <- rnorm(n=N, mean=Mu, sd=Sigma)
jagsdata <- list(y=y)
jags.script <- "
model {
for (i in 1:length(y)) {
y[i] ~ dnorm(mu, tau)
}
mu ~ dnorm(0, 0.001)
sigma ~ dunif(0, 1000)
tau <- 1/sigma^2
}"
mod1 <- jags.model(textConnection(jags.script), data=jagsdata, n.chains=4,
n.adapt=1000)
update(mod1, 200) # burn in
mod1.samples <- coda.samples(model=mod1,
variable.names=c('mu', 'sigma'),
n.iter=1000)
plot(mod1.samples)
I just want to run something like abline(v=100) for mu and abline(v=15) for sigma. Of course in many other examples, I would have 5, 10, 20 or more parameters of interest. Thus, I'm interested in being able to supply a vector of true values for named parameters.
I've had a look at getAnywhere(plot.mcmc). Would modifying that be a good way to go?
Okay. So I modified plot.mcmc to look like this:
my.plot.mcmc <- function (x, trace = TRUE, density = TRUE, smooth = FALSE, bwf,
auto.layout = TRUE, ask = FALSE, parameters, ...)
{
oldpar <- NULL
on.exit(par(oldpar))
if (auto.layout) {
mfrow <- coda:::set.mfrow(Nchains = nchain(x), Nparms = nvar(x),
nplots = trace + density)
oldpar <- par(mfrow = mfrow)
}
for (i in 1:nvar(x)) {
y <- mcmc(as.matrix(x)[, i, drop = FALSE], start(x),
end(x), thin(x))
if (trace)
traceplot(y, smooth = smooth, ...)
if (density) {
if (missing(bwf)) {
densplot(y, ...); abline(v=parameters[i])
} else densplot(y, bwf = bwf, ...)
}
if (i == 1)
oldpar <- c(oldpar, par(ask = ask))
}
}
Then running the command
my.plot.mcmc(mod1.samples, parameters=c(Mu, Sigma))
produces this
Note that parameters must be a vector of values in the same sort order as JAGS sorts variables, which seems to be alphabetically and then numerically for vectors.
Lessons learnt
Simply writing a new plot.mcmc didn't work by default presumably because of namespaces. So I just created a new function
I had to change set.mfrow to coda:::set.mfrow presumably also because of namespaces.
I changed ask to ask=FALSE, because RStudio permits browsing through figures.
I'd be happy to hear any suggestions about better ways of overriding or adapting existing S3 methods.