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)