alpha <- 2; beta <- 1
laplace_ml <- function(y) { n <- length(y); s <- sum(y)
h <- function(l) -(sum(dpois(y, l, log = TRUE)) + dgamma(l, alpha, beta, log = TRUE))
op <- optim(mean(y) + 0.5, h, method = "L-BFGS-B", lower = 1e-6, hessian = TRUE)
c(mode = op$par, log_ml = -op$value + 0.5 * log(2 * pi) - 0.5 * log(op$hessian[1, 1])) }
exact_log_ml <- function(y) { n <- length(y); s <- sum(y)
alpha * log(beta) - lgamma(alpha) + lgamma(alpha + s) - (alpha + s) * log(beta + n) - sum(lfactorial(y)) }
res <- t(sapply(c(5, 20, 100, 500), function(n) { y <- rpois(n, 3)
c(n = n, laplace_ml(y), exact = exact_log_ml(y), post_mean = (alpha + sum(y)) / (beta + n)) }))
round(cbind(res, error = res[, "log_ml"] - res[, "exact"]), 4)