Maximum likelihood estimator stuck at bounds

117 views Asked by At

I'm working on setting up a maximum likelihood estimator to estimate the parameters for a dirichlet-multinomial distribution. Based on what I've seen elsewhere, it looks like the function ddirichlet.multinom() is working as expected, but when I pass to the log-likelihood function, mle seems to want to push it to the lower bounds! I figure I've mixed something up in either the function ll() or in the params for mle(), but can't seem to sort out what the issue is. Any guidance here would be much appreciated!

library(tidyverse)

# setup a set of example data using a known dirichlet distribution
ex_data <- 
  gtools::rdirichlet(500, c(37, 5, 13, 120)) %>%
  as_tibble(.name_repair = "universal") %>%
  rename_with(~str_replace(.x, "...", "x")) %>%
  add_column(n = round(rnorm(500, 750, 20))) %>%
  mutate(across(starts_with("x"), ~round(.x * n))) %>%
  select(-n)
#> New names:
#> • `` -> `...1`
#> • `` -> `...2`
#> • `` -> `...3`
#> • `` -> `...4`

ex_data
#> # A tibble: 500 × 4
#>       x1    x2    x3    x4
#>    <dbl> <dbl> <dbl> <dbl>
#>  1   153    23    81   498
#>  2   156    18    65   500
#>  3   208     6    40   479
#>  4   142    25    73   524
#>  5   181     9    54   497
#>  6   139    21    40   512
#>  7   184    24    49   495
#>  8   137    10    39   544
#>  9   153     9    44   519
#> 10   186    21    42   464
#> # … with 490 more rows

# density function for dirichlet multinomial distribution;
# based on checks w/other implementations, this seems to be working as expected
ddirichlet.multinom <- function(x, alpha, log = FALSE) {
  
  a0 <- sum(alpha)
  n <- sum(x)
  const <- lgamma(a0) + lgamma(n + 1) - lgamma(n + a0)
  
  pr <- vector(length = length(x))
  
  for (i in 1:length(x)) {
    
    pr[i] <- lgamma(x[i] + alpha[i]) - lgamma(alpha[i]) - lgamma(x[i] + 1)
    
  }
  
  prob <- const * prod(pr)
  
  if (log) prob else exp(prob)
  
}


# negative log-likelihood function
# seems to get stuck at the lower bound!
ll <- function(a1, a2, a3, a4) {
  
  x1 <- ex_data$x1
  x2 <- ex_data$x2
  x3 <- ex_data$x3
  x4 <- ex_data$x4
  
  log_likelihood <- vector("double", length = length(x1))
  
  for (i in 1:length(x1)) {
    
    log_likelihood[i] <- 
      ddirichlet.multinom(
        c(x1[i], x2[i], x3[i], x4[i]),
        c(a1, a2, a3, a4),
        log = TRUE
      )
    
  }
  
  -sum(log_likelihood)
  
}

# ll max likelihood estimation 
# depending on the example, it either gets stuck at the lower limit or it
# varies wildly with the starting params
stats4::mle(
  ll,
  method = "L-BFGS-B",
  start = c(37, 5, 13, 120),
  lower = c(1.0001, 1.0001, 1.0001, 1.0001)
)
#> 
#> Call:
#> stats4::mle(minuslogl = ll, start = c(37, 5, 13, 120), method = "L-BFGS-B", 
#>     lower = c(1.0001, 1.0001, 1.0001, 1.0001))
#> 
#> Coefficients:
#>     a1     a2     a3     a4 
#> 1.0001 1.0001 1.0001 1.0001

Created on 2022-07-07 by the reprex package (v2.0.1)

0

There are 0 answers