我正在使用optim()进行最大似然估计,这很容易。这是一个带有4个参数和一些限制的广义逻辑分布,所有这些都列在似然函数中:
genlogis.loglikelihood <- function(param = c(sqrt(2/pi),0.5, 2, 0), x){
if(length(param) < 3 | length(param) > 4 ){
stop('Incorrect number of parameters: param = c(a,b,p,location)')
}
if(length(param) == 3){
#warning('Location parameter is set to 0')
location = 0
}
if(length(param) == 4){
location = param[4]
}
a = param[1]
b = param[2]
p = param[3]
if(!missing(a)){
if(a < 0){
stop('The argument "a" must be positive.')
}
}
if(!missing(b)){
if(b < 0){
stop('The argument "b" must be positive.')
}
}
if(!missing(p)){
if(p < 0){
stop('The argument "p" must be positive.')
}
}
if(p == 0 && b > 0 && a > 0){
stop('If "p" equals to 0, "b" or "a" must be
0 otherwise there is identifiability problem.')
}
if(b == 0 && a == 0){
stop('The distribution is not defined for "a"
and "b" equal to 0 simultaneously.')
}
z <- sum(log((a+b*(1+p)*abs((x-location))^p ) * exp(-((x-location)*(a+b*abs((x-location))^p))))) -
sum(2*log(exp(-((x-location)*(a+b*abs((x-location))^p))) + 1))
if(!is.finite(z)){
z <- 1e+20
}
return(-z)
}
我做了它的似然功能并以这种方式工作:
opt <- function(parameters, data){
optim(par = parameters, fn = genlogis.loglikelihood, x=data,
lower = c(0.00001,0.00001,0.00001, -Inf),
upper = c(Inf,Inf,Inf,Inf), method = 'L-BFGS-B')
}
opt(c(0.3, 1.01, 2.11, 3.5), faithful$eruptions)
由于此函数以数字方式进行渐变,因此我没有太多问题。
然后我想改为constrOptim()
,因为边界实际上是0而前3个参数上的数字不是很小。但是,我面临的问题是必须指定参数grad
并且我无法派生该函数来提供渐变函数,因此我必须在optim()
中以数字方式进行,它的工作原理如果我放grad = NULL
但我不想要Nelder-Mead方法而是BFGS。
我尝试过这种方式,但并没有太多成功:
opt2 <- function(initial, data){
ui <- rbind(c(1, 0, 0, 0), c(0,1,0,0), c(0,0,1,0))
ci <- c(0,0,0)
constrOptim(theta = initial, f = genlogis.loglikelihood(param, x),
grad = numDeriv::grad(func = function(x, param) genlogis.loglikelihood(param, x), param = theta, x = data)
, x = data, ui = ui, ci = ci)
}
答案 0 :(得分:0)
你的记谱有点复杂,也许让你很困惑。
opt2 <- function(parameters, data){
fn = function(p) genlogis.loglikelihood(p, x = data)
gr = function(p) numDeriv::grad(fn, p)
ui <- rbind(c(1, 0, 0, 0), c(0,1,0,0), c(0,0,1,0))
ci <- c(0,0,0)
constrOptim(theta = parameters, f = fn, grad = gr,
ui = ui, ci = ci, method="BFGS")
}
opt2(c(0.3, 1.01, 2.11, 3.5), faithful$eruptions)