I'm doing maximum likelihood estimation using the R optim function.
The command I used is
optim(3, func, lower=1.0001, method="L-BFGS-B")$par
The function func has infinite value if the parameter is 1.
Thus I set the lower value to be 1.0001.
But sometime an error occurs.
Error in optim(3, func, lower = 1.0001, method = "L-BFGS-B", sx = sx, :
L-BFGS-B needs finite values of 'fn'
What happened next is hard to understand.
If I run the same command again, then it gives the result 1.0001 which is lower limit.
It seems that the optim function 'learns' that 1 is not the proper answer.
How can the optim function can give the answer 1.0001 at my first run?
P.S.
I just found that this problem occurs only in stand-alone R-console. If I run the same code in R Studio, it does not occur. Very strange.
The method "L-BFGS-B" requires all computed values of the function to be finite.
It seems, for some reason, that optim is evaluating your function at the value of 1.0, giving you an inf, then throwing an error.
If you want a quick hack, try defining a new function that gives a very high value(or low if you're trying to maximize) for inputs of 1.
func2 <- function(x){
if (x == 1){
return -9999
}
else{
return func(x)
}
}
optim(3, func2, lower=1.0001, method="L-BFGS-B")$par
(Posted as answer rather than comment for now; will delete later if appropriate.)
For what it's worth, I can't get this example (with a singularity at 1) to fail, even using the default control parameters (e.g. ndeps=1e-3):
func <- function(x) 1/(x-1)*x^2
library(numDeriv)
grad(func,x=2) ## critical point at x=2
optim(par=1+1e-4,fn=func,method="L-BFGS-B",lower=1+1e-4)
Try a wide range of starting values:
svec <- 1+10^(seq(-4,2,by=0.5))
sapply(svec,optim,fn=func,method="L-BFGS-B",lower=1+1e-4)
These all work.
Related
I have derived a survival function for a system of components (ignore the details of how this system is setup) and I am trying to maximize its expected, or more specifically, maximizing the expected value of the function:
surv_func = function(x,mu) = {(exp(-(x/(mu))^(1/3))*((1-exp(-(4/3)*x^(3/2)))+exp(-(-(4/3)*x^(3/2)))))*exp(-(x/(3-mu))^(1/3))}
and I am supposed (since the pdf including my tasks gives a hint about it) to use the function
optimize()
and the expected value for a function can be computed with
# Computes expected value of a the function "function"
E <- integrate(function, 0, Inf)
but my function depends on x and mu. The expected value could (obviously) be computed if the integral had no mu but instead only depended on x. For those interested, the mu comes from the fact that one of the components has a Weibull-distribution with parameters (1/3,mu) and the 3-mu comes from that has a Weibull-distribution with parameters (1/3,lambda). In the task there is a constraint mu + lambda = 3, so I tought substituting the lambda-parameter in the second Weibull-distribution with lambda = 3 - mu and trying to maximize this problem would yield not only mu, but also lambda.
If I try to, just for the sake of learing about R, compute the expected value using the code below (in the console window), it just gives me the following:
> E <- integrate(surv_func,0,Inf)
Error in (function (x, mu) : argument "mu" is missing, with no default
I am new to R and seem to be a little bit "slow" at learning. How can I approach this problem?
Issue 1
I have an objective function, gFun(modelOutput,l,u), which returns 0 if the simulated output is in interval [l,u], otherwise it returns a positive(!) number.
OFfun <- function(params) {
out <- simulate(params)
OF <- gFun(out,0,5)
return(OF)
}
The objective function is called from the optim function with some tolerance settings.
fitval=optim(par=parms,fn=OFfun,method="SANN",control = list(abstol = 1e-2))
summary(fitval)
My issue is that the optimization doesn't stop if the OFfun == 0.
I have tried with the condition below:
if (OF == 0){
opt <- options(show.error.messages=FALSE)
on.exit(options(opt))
stop()
}
it works but it doesn't return the OF back to optim and therefore I don't get the fitval info with estimated parameters.
Issue 2
Another issue is that the solver sometimes crashes and aborts the entire optimisation. I would like to harvest many solution sets for different initial guesses - so I need to handle failed simulations. probably related to issue 1.
Any advice would be very appreciated.
I am using the function plkhci from library Bhat to construct Profile-likelihood based confidence intervals and I got this warning:
Warning message: In dqstep(list(label = x$label, est = btrf(xt, x$low,
x$upp), low = x$low, : oops: unable to find stepsize, use default
when i run
r <- dfp(x,f=nlogf)
Can I ignore this warning as I still can get the output?
Following is the complete coding:
library(Bhat)
beta0<--8
beta1<-0.03
gamma<-0.0105
alpha<-0.05
n<-100
u<-runif(n)
u
x<-rnorm(n)
x
c<-rexp(100,1/1515)
c
t1<-(1/gamma)*log(1-((gamma/(exp(beta0+beta1*x)))*(log(1-u))))
t1
t<-pmin(t1,c)
t
delta<-1*(t1>c)
delta
length(delta)
cp<-length(delta[delta==1])/n
cp
delta[delta==1]<-ifelse(rbinom(length(delta[delta==1]),1,0.5),1,2)
delta
deltae<-ifelse(delta==0, 1,0)
deltar<-ifelse(delta==1, 1,0)
deltai<-ifelse(delta==2, 1,0)
dat=data.frame(t,delta, deltae,deltar,deltai,x)
dat$interval[delta==2] <- as.character(cut(dat$t[delta==2], breaks=seq(0, 600, 100)))
labs <- cut(dat$t[delta==2], breaks=seq(0, 600, 100))
dat$lower[delta==2]<-as.numeric( sub("\\((.+),.*", "\\1", labs) )
dat$upper[delta==2]<-as.numeric( sub("[^,]*,([^]]*)\\]", "\\1", labs) )
data0<-dat[which(dat$delta==0),]#uncensored data
data1<-dat[which(dat$delta==1),]#right censored data
data2<-dat[which(dat$delta==2),]#interval censored data
nlogf<-function(para)
{
b0<-para[1]
b1<-para[2]
g<-para[3]
e<-sum((b0+b1*data0$x)+g*data0$t+(1/g)*exp(b0+b1*data0$x)*(1-exp(g*data0$t)))
r<-sum((1/g)*exp(b0+b1*data1$x)*(1-exp(g*data1$t)))
i<-sum(log(exp((1/g)*exp(b0+b1*data2$x)*(1-exp(g*data2$lower)))-exp((1/g)*exp(b0+b1*data2$x)*(1-exp(g*data2$upper)))))
l<-e+r+i
return(-l)
}
x <- list(label=c("beta0","beta1","gamma"),est=c(-8,0.03,0.0105),low=c(-10,0,0),upp=c(10,1,1))
r <- dfp(x,f=nlogf)
x$est <- r$est
plkhci(x,nlogf,"beta0")
plkhci(x,nlogf,"beta1")
plkhci(x,nlogf,"gamma")
I am giving you a super long answer, but it will help you see that you can chase down your own error messages (most of the time, sometimes this means of looking at functions will not work). It is good to see what is happening inside a method when it throws an warning because sometimes it is fine and sometimes you need to fix your data.
This function is REALLY involved! You can look at it by typing dfp into the R command line (NO TRAILING PARENTHESES) and it will print out the whole function.
17 lines from the end, you will see an assignment:
del <- dqstep(x, f, sens = 0.01)
You can see that this calls the function dqstep, which is reflected in your warning.
You can see this function by typing dqstep into the command line of R again. In reading through this function, also long but not so tedious, there is this section of boolean logic:
if (r < 0 | is.na(r) | b == 0) {
warning("oops: unable to find stepsize, use default")
cat("problem with ", x$label[i], "\n")
break
}
This is the culprit, it returns the message you are getting. The line right above it spells out how r is calculated. You are feeding this function your default x from the prior function plus a sensitivity equations (which I assume dfp generates, it is huge and ugly, so I did not untangle all of it). When the previous nested function returns either an r value lower than Zero, and r value of NA or a b value of ZERO, that message is displayed.
The second error tells you that it was likely b==0 because b is in the denominator and it returned and infinity value, so NO STEP SIZE IS RETURNED FROM THIS NESTED FUNCTION to the variable del in dfp.
The step is fed into THIS equation:
h <- logit.hessian(x, f, del, dapprox = FALSE, nfcn)
which you can look into by typing logit.hessian into the R commandline.
When you do, you see that del is a step size in a logit scale, with a default value of del=rep(0.002, length(x$est))...which the function set for you because running the function dqstep returned no value.
So, you now get to decide if using that step size in the calculation of your confidence interval seems right or if there is a problem with your data which needs resolving to make this work better for you.
When I ran it, line by line, I got this message:
Error in if (denom <= 0) { : missing value where TRUE/FALSE needed
at this line of code:
r <- dfp(x,f=nlogf(x))
Which makes me think I was correct.
That is how I chase down issues I have with messages from packages when I get a message like yours.
I am taking a numeric calculus class and we are not required to know any scilab programming except the very basic, which is taught through a booklet, since the class is mostly theoretical. I was reading the booklet and found this scilab code meant to find a root of a function through bissection method.
The problem is, I can't find a way to make it work. I tried to call it with bissecao(x,-1,1,0.1,40) however it didn't work.
The error I got was:
at line 3 of function bissecao ( E:\Downloads\bisseccao3.sce line 3 )
Invalid index.
As I highly doubt that the code itself isn't working, and I tried to search for anything I could spot that seemed wrong, to no avail, I guess I am probably calling it wrong, somehow.
The code is the following:
function p = bissecao(f, a, b, TOL, N)
i = 1
fa = f(a)
while (i <= N)
//iteraction of the bissection
p = a + (b-a)/2
fp = f(p)
//stop condition
if ((fp == 0) | ((b-a)/2 < TOL)) then
return p
end
//bissects the interval
i = i+1
if (fa * fp > 0) then
a = p
fa = fp
else
b = p
end
end
error ('Max number iter. exceded!')
endfunction
Where f is a function(I guess), a and b are the limits of the interval in which we will be iterating, TOL is the tolerance at which the program terminates close to a zero, and N is the maximum number of iteractions.
Any help on how to make this run is greatly appreciated.
Error in bissecao
The only error your bissecao function have is the call to return :
In a function return stops the execution of the function,
[x1,..,xn]=return(a1,..,an) stops the execution of the function and
put the local variables ai in calling environment under names xi.
So you should either call it without any argument (input our output) and the function will exit and return p.
Or you could call y1 = return(p) and the function will exit and p will be stored in y1.
It is better to use the non-arguments form return in functions to avoid changing values of variables in the parent/calling script/functions (possible side-effect).
The argument form is more useful when interactively debugging with pause:
In pause mode, it allows to return to lower level.
[x1,..,xn]=return(a1,..,an) returns to lower level and put the local
variables ai in calling environment under names xi.
Error in calling bissecao
The problem may come by your call: bissecao(x,-1,1,0.1,40) because you didn't defined x. Just fixing this by creating a function solves the problem:
function y=x(t)
y=t+0.3
enfunction
x0=bissecao(x,-1,1,0.1,40) // changed 'return p' to 'return'
disp(x0) // gives -0.3 as expected
My problem (and what I think could help to solve it) is explained until the line "FOR REPRODUCTION". After that I just posted my code, just in case reproducing might help to solve it.
I use optim and constrOptim.nl to solve an optimization problem with constraints within the function g (see below) I wrote.
I know that the initial values used below are not ideal, but I chose them
because they cause the problem I face in a shorter program. I use this program to calibrate model parameters to data and there this problem also occurs for better inital values, higher tolerances etc.
The Error
I call the function get_par I wrote with:
v<-c(0.12504710,0.09329359,0.06778733, 0.04883216, 0.04187344,0.02886261,0.02332951,0.02178576,0.02282214,0.02956336,0.03478598)
Ti=1/12
x<-log(cbind(0.8,0.85,0.9,0.95,0.975,1,1.025,1.05,1.1,1.15,1.2))
g(par2=c(-5,5),v=v,Ti=Ti,x=x)
Then I get
Error in optim: inital value 'vmmin' is not finite.
What I have observed so far
So I started to debug my code to find out where exactly this error occurs. The error occurs in the function g (see below) in the line ( with the values sigma=5,m=-5,y=(x-m)/sigma,vtilde=v/12)
#print(paste("vW: sigma: ",sigma,"mv:",mv))
argmin<-constrOptim.nl(par=c(3*sigma,sigma,mv/2),fn=f,hin.jac=hinv.jac,
hin=hinv,heq.jac=heqv.jac,heq=heqv,control.outerlist(trace=T),
control.optim=list(abstol=10^(-10)),y=y,vtilde=vtilde,sigma=sigma)
The Trace of the funciton constrOptim.nl displays
Outer iteration: 18
Min(hin): 1.026858e-19 Max(abs(heq)): 0
par: 10 9.99998 1.02686e-19
fval = 6399
for the last iteration. I guess that there is some sort of a numerical problem with 1.02686e-19 appearing in the last iteration.
I had a look into the function constrOptim.nl and albama (with debug() ), and the error exactly occurs in the line
theta.old <- theta
atemp <- optim(par = theta, fn = fun, gr = grad, control = control.optim,
method = "BFGS", hessian = TRUE, ...)
where theta=theta.old has the value
Browse[2]> theta.old
[1] 1.000002e+01 9.999985e+00 -3.349452e-20
Hence it has an entry that is just below zero (its absolute value is even smaller than machine accuracy, isn't it?).
When you look at the function fun you realize that it calls the function
R:
function (theta, theta.old, ...)
{
gi <- hin(theta, ...)
if (any(gi < 0))
return(NaN)
gi.old <- hin(theta.old, ...)
hjac <- hin.jac(theta.old, ...)
bar <- sum(gi.old * log(gi) - hjac %*% theta)
if (!is.finite(bar))
bar <- -Inf
fn(theta, ...) - mu * bar
}
hin(theta,...)=hinv(theta,...) returns a vector with a negative entry, thus this function returns NaN. I suppose that this should cause the error message: "Error in optim: inital value 'vmmin' is not finite". My question is now:
How can I fix that? I thought of forcing the program to terminate somehow when such small values occur, but I have not managed to do that yet. What do yo suggest?
Many thanks in advance,
FOR REPRODUCTION:
Here is my program:
The functions hinv, hinv.jac, heq and heq.jac are just for the constraints. The function where I optimize is g.
library(alabama)
library(dfoptim)
#function f, par = (c,d,atilde)
f<-function(par3,y,vtilde,sigma){
sum((par3[3]+par3[2]*y+par3[1]*sqrt(y^2+1)-vtilde)^2)
}
#Equality/Inequality constraints
heqv<-function(par3,y,vtilde,sigma){
J1<-matrix(1/2*cbind(sqrt(2),sqrt(2),-sqrt(2),sqrt(2)),nrow=2,ncol=2)
J2<-matrix(0,nrow=3,ncol=3)
J2[1:2,1:2]<-J1
J2[3,3]<-1
j<-J2%*%par3
j[2]-2*sqrt(2)*sigma
}
#Jacobian-matrix
hinv.jac<-function(par3,y,vtilde,sigma){
#J1, J2: Drehungen für die constraints
J1<-matrix(1/2*cbind(sqrt(2),sqrt(2),-sqrt(2),sqrt(2)),nrow=2,ncol=2)
J2<-matrix(0,nrow=3,ncol=3)
J2[1:2,1:2]<-J1
J2[3,3]<-1
hjac<-matrix(cbind(1,-1,0,0,0,0,0,0,0,0,1,-1),nrow=4)%*%J2
hjac
}
hinv<-function(par3,y,vtilde,sigma){
#J1, J2: Drehungen für die constraints
J1<-matrix(1/2*cbind(sqrt(2),sqrt(2),-sqrt(2),sqrt(2)),nrow=2,ncol=2)
J2<-matrix(0,nrow=3,ncol=3)
J2[1:2,1:2]<-J1
J2[3,3]<-1
j<-J2%*%par3
h<-rep(NA,4)
h[1]<- j[1]
h[2]<- sqrt(2)*2*sigma-j[1]
h[3]<-j[3]
h[4]<-max(vtilde)-j[3]
h
}
#Jacobian-matrix
heqv.jac<-function(par3,y,vtilde,sigma){
#J1, J2: Drehungen für die constraints
J1<-matrix(1/2*cbind(sqrt(2),sqrt(2),-sqrt(2),sqrt(2)),nrow=2,ncol=2)
J2<-matrix(0,nrow=3,ncol=3)
J2[1:2,1:2]<-J1
J2[3,3]<-1
cbind(J2[2,1],J2[2,2],0)
}
#function g input: par2= (m,sigma): optimization of function f
g<-function(par2,v,Ti,x){
#definition of parameters being used
m<-par2[1]
sigma<-par2[2]
y<-(x-m)/sigma #Transformation von x zu y gemäß paper
vtilde<-Ti*v
mv<-max(vtilde)
#print(paste("vW: sigma: ",sigma,"mv:",mv))
argmin<-constrOptim.nl(par=c(3*sigma,sigma,mv/2),fn=f,hin.jac=hinv.jac,hin=hinv,heq.jac=heqv.jac,heq=heqv,control.outer=list(trace=F),control.optim=list(abstol=10^(-10)),y=y,vtilde=vtilde,sigma=sigma)
argmin$par
}