I did searched the questions here before posting and I found only one question in this regard but it doesn't apply to my case.
I have uploaded the data for PRD, INJ, tao and lambda with the links below, which shall be used to reproduce the code:
PRD
INJ
lambda
tao
the code:
PRD=read.csv(file="PRD.csv")
INJ=read.csv(file="INJ.csv")
PRD=do.call(cbind, PRD)
INJ=do.call(cbind, INJ)
tao=do.call(cbind, read.csv(file="tao.csv",header=FALSE))
lambda=do.call(cbind, read.csv(file="lambda.csv",header=FALSE))
fn1 <- function (tao,lambda) {
#perparing i.dash
i.dash=matrix(ncol=ncol(INJ), nrow=(nrow(INJ)))
for (i in 1:ncol(INJ)){
for (j in 1:nrow (INJ)){
temp=0
for (k in 1:j){
temp=(1/tao[i])*exp((k-j)/tao[i])*INJ[k,i]+temp
}
i.dash[j,i]=temp
}
#preparing lambdaXi.dash
lambda.i=matrix(ncol=ncol(INJ),nrow=nrow(INJ))
for (i in 1: ncol(INJ)){
lambda.i[,i]=lambda[i+1]*i.dash[,i]
}
#calc. q. hat (I need to add the pp term)
q.hat=matrix(nrow=nrow(INJ),1 )
for (i in 1:nrow(INJ)){
q.hat[i,1]=sum(lambda.i[i,1:ncol(INJ)])
target= sum((PRD[,1]-q.hat[,1])^2)
}
}
}
what I am trying to do is to minimize the value target by optimizing lambda and tao which the starting values will be the same as the ones uploaded above. I've used optim to do so but I still receive the error cannot coerce type 'closure' to vector of type double
I've used many variations of optim and still recieve the same error.
the last syntax I've used was optim(fn1, tao=tao, lambda=lambda, hessian=T)
Thanks
The calling form of optim is
optim(par, fn, gr = NULL, ...,
method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN",
"Brent"),
lower = -Inf, upper = Inf,
control = list(), hessian = FALSE)
So, you need to pass the parameters first, not the function. Note that "closure" is another term for "function", which explains the error message: you have passed a function as the first argument, when optim expected initial parameter values.
Note also, that optim only optimises over the first argument of the function fn, so you will need to redesign your function fn1 so it only takes a single function. For example, it could be a single vector where of the form c(n, t1, t2,...,tn, l1, l2, l3, ... lm) where ti are the components of tao and li components of lambda and n tells you how many components tao has.
Related
I have a wrapper function of two functions. Each function has its own parameters vectors. The main idea is to pass the vectors of parameters (which is a vector or two vectors) to optim and then, I would like to maximize the sum of the function.
Since my function is so complex, then I tried to provide a simple example which is similar to my original function. Here is my code:
set.seed(123)
x <- rnorm(10,2,0.5)
ff <- function(x, parOpt){
out <- -sum(log(dnorm(x, parOpt[[1]][1], parOpt[[1]][2]))+log(dnorm(x,parOpt[[2]][1],parOpt[[2]][2])))
return(out)
}
# parameters in mu,sd vectors arranged in list
params <- c(set1 = c(2, 0.2), set2 = c(0.5, 0.3))
xy <- optim(par = params, fn=ff ,x=x)
Which return this error:
Error in optim(par = params, fn = ff, x = x) :
function cannot be evaluated at initial parameters
As I understand, I got this error because optim cannot pass the parameters to each part of my function. So, how can I tell optim that the first vector is the parameter of the first part of my function and the second is for the second part.
You should change method parameter to use initial parameters.
You can read detailed instructions about optim function using ?optim command.
For example you can use "L-BFGS-B" method to use upper and lower constraints.
I have a function that works just fine when asked to calculate the -logLik given parameters. However, if I try to optimize the function it returns an error message. I'm familiar with debug() to work through problems with a function, but how would I go about debugging optimization for a function that othwerwise works?
Lik <- function(params, data) {
....
return(-log( **likelihood equation** ))
}
These work!
Lik(params=c(3,10,2,9,rowMeans(data[1,])[1]), data = data1)
Lik(params=c(3,10,2,9.5,rowMeans(data[1,])[1]), data = data1)
GENE1 32.60705
GENE1 32.31657
This doesn't work!
optim(params=c(3,10,2,9,rowMeans(data[1,])[1]), data = data1, Lik, method = "BFGS")
Error in optim(params = c(3, 10, 2, 9, rowMeans(data[1, ])[1]), data = data1, :
cannot coerce type 'closure' to vector of type 'double'
The optim parameter name for the parameters to optimize over is par, not params. You don't need to change your Lik function, it just needs to have the parameters to optimize over as the first argument, the name doesn't matter.
This should work. Here I name the fn argument too, but because the others are named the positional finding works.
optim(par=c(3, 10, 2, 9, rowMeans(data[1, ])[1]),
data=data1, fn=Lik, method="BFGS")
So what was happening in your code was that it was saving both params and data to send to the function, and then the first unnamed parameter was Lik so it was getting matched to the first parameter of optim, which is par, the parameters to optimize over. That parameter should be a numeric (a double, technically) but you were sending it a function (a closure, technically), hence the error message.
To debug, you could have turned on debugging for optim debug(optim) and then at the first browse, explored what the parameters were that it was using. You would have found exactly this, though simply in exploring the parameters, you would have discovered you named them incorrectly.
Browse[2]> print(par)
function(params, data) {... return(-log( **likelihood equation** ))}
Browse[2]> print(fn)
Error in print(fn) : argument "fn" is missing, with no default
It is bad practice to use built-in function names as object names created (or to be created) by the user.
When there is no "data" object (a matrix or a data frame) yet created by the user, R interpreter scans the environments and finds that the only object named "data" is the built in "data" function:
> class(data)
[1] "function"
> str(data)
function (..., list = character(), package = NULL, lib.loc = NULL, verbose = getOption("verbose"),
envir = .GlobalEnv)
Hence R treats the "data" object as a closure (a function declaration) that cannot be subsetted:
> data[1]
Error in data[1] : object of type 'closure' is not subsettable
So you should change the name of the parameter to sth other than data.
And a second point, the syntax of optim is:
optim(par, fn, gr = NULL, ...,
method = c("Nelder-Mead", "BFGS", "CG", "L-BFGS-B", "SANN",
"Brent"),
lower = -Inf, upper = Inf,
control = list(), hessian = FALSE)
So in your example, the second parameter supplied to optim should be the function Lik, not the data. And the interpreter tries to interpret data1 as a closure. You can try to swap the positions of data1 and Lik.
And more importantly as #李哲源ZheyuanLi also points, there is no parameter in optim named as "data". You should just write it as "data1" in place of the additional function parameters "...".
And last, as also #Aaron pointed out, the first parameter is named "par" not params".
I would like to know how to do the maximum likelihood estimation in R when fitting parameters are given in an array. This is needed when the number of parameters is large. So basically, to fit a normal distribution to the data x, I would like to do something like the following
LL <- function(param_array) {
R = dnorm(x, param_array[1], param_array[2])
-sum(log(R))
}
mle(LL, start = list(param_array = c(1,1)))
(Instead of this original code in the first section of http://www.r-bloggers.com/fitting-a-model-by-maximum-likelihood/)
If I ran the code above I will get an error
Error in dnorm(x, param_array[1], param_array[2]) : argument
"param_array" is missing, with no default
Could anyone let me know how to achieve what I want in the correct way?
stats4::mle is not a long function, you can inspect it in your R console:
> stats4::mle
Note how start is handled:
start <- sapply(start, eval.parent)
nm <- names(start)
case 1
If you do:
LL <- function(mu, sigma) {
R = dnorm(x, mu, sigma)
-sum(log(R))
}
mle(LL, start = list(mu = 1, sigma = 1))
you get:
nm
#[1] "mu" "sigma"
Also,
formalArgs(LL)
#[1] "mu" "sigma"
case 2
If you do:
LL <- function(param_array) {
R = dnorm(x, param_array[1], param_array[2])
-sum(log(R))
}
mle(LL, start = list(param_array = c(1,1)))
you get
nm
#[1] NULL
but
formalArgs(LL)
#[1] param_array
The problem
The evaluation of function LL inside stats::mle is by matching nm to the formal arguments of LL. In case 1, there is no difficulty in matching, but in case 2 you get no match, thus you will fail to evaluate LL.
So what do people do if they have like 50 parameters? Do they type them in by hand?
Isn't this a bogus argument, after a careful reflection? If you really have 50 parameters, does using an array really save your effort?
First, inside your function LL, you have to specify param_array[1], param_array[2], ..., param_array[50], i.e., you still need to manually input 50 parameters into the right positions. While when specifying start, you still need to type in a length-50 vector element by element, right? Isn't this the same amount of work, compared with not using an array but a list?
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.
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
}