如何在constrOptim

时间:2017-09-04 22:17:39

标签: r arguments constraints gradient numerical

我正在使用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)
        }

1 个答案:

答案 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)