Tại sao glmer không đạt được khả năng tối đa (như được xác minh bằng cách áp dụng tối ưu hóa chung hơn nữa)?

Rất nhiều lần lấy được MLE của GLMM rất khó và trong thực tế, tôi biết, chúng ta không nên sử dụng tối ưu hóa vũ lực (ví dụ, sử dụng optimmột cách đơn giản). Nhưng với mục đích giáo dục của riêng tôi, tôi muốn thử nó để đảm bảo rằng tôi hiểu chính xác mô hình (xem mã bên dưới). Tôi thấy rằng tôi luôn nhận được kết quả không nhất quán từ glmer().

Cụ thể, ngay cả khi tôi sử dụng MLE từ glmercác giá trị ban đầu, theo hàm khả năng tôi đã viết ( negloglik), chúng không phải là MLE ( opt1$valuenhỏ hơn opt2). Tôi nghĩ hai lý do tiềm năng là:

1. negloglik không được viết tốt để có quá nhiều lỗi số trong đó và
2. đặc điểm kỹ thuật mô hình là sai. Đối với đặc tả mô hình, mô hình dự định là:

f g a b

$$\begin{equation} L=\prod_{i=1}^{n} \left(\int_{-\infty}^{\infty}f(y_i|N,a,b,r_{i})g(r_{i}|s)dr_{i}\right) \end{equation}$$ trong đó là nhị phân pmf và là pdf bình thường. Tôi đang cố gắng ước tính , và . Cụ thể, tôi muốn biết nếu đặc tả mô hình là sai, đặc điểm kỹ thuật chính xác là gì.$f$$g$$a$$b$$s$

p <- function(x,a,b) exp(a+b*x)/(1+exp(a+b*x))

a <- -4  # fixed effect (intercept)
b <- 1   # fixed effect (slope)
s <- 1.5 # random effect (intercept)
N <- 8
x <- rep(2:6, each=20)
n <- length(x) 
id <- 1:n
r  <- rnorm(n, 0, s) 
y  <- rbinom(n, N, prob=p(x,a+r,b))


negloglik <- function(p, x, y, N){
  a <- p[1]
  b <- p[2]
  s <- p[3]

  Q <- 100  # Inf does not work well
  L_i <- function(r,x,y){
    dbinom(y, size=N, prob=p(x, a+r, b))*dnorm(r, 0, s)
  }

  -sum(log(apply(cbind(y,x), 1, function(x){ 
    integrate(L_i,lower=-Q,upper=Q,x=x[2],y=x[1],rel.tol=1e-14)$value
  })))
}

library(lme4)
(model <- glmer(cbind(y,N-y)~x+(1|id),family=binomial))

opt0 <- optim(c(fixef(model), sqrt(VarCorr(model)$id[1])), negloglik, 
                x=x, y=y, N=N, control=list(reltol=1e-50,maxit=10000)) 
opt1 <- negloglik(c(fixef(model), sqrt(VarCorr(model)$id[1])), x=x, y=y, N=N)
opt0$value  # negative loglikelihood from optim
opt1        # negative loglikelihood using glmer generated parameters
-logLik(model)==opt1 # but these are substantially different...

Một ví dụ đơn giản hơn

Để giảm khả năng có lỗi số lớn, tôi đã tạo một ví dụ đơn giản hơn.

y  <- c(0, 3)
N  <- c(8, 8)
id <- 1:length(y)

negloglik <- function(p, y, N){
  a <- p[1]
  s <- p[2]
  Q <- 100  # Inf does not work well
  L_i <- function(r,y){
    dbinom(y, size=N, prob=exp(a+r)/(1+exp(a+r)))*dnorm(r,0,s)
  }
  -sum(log(sapply(y, function(x){
    integrate(L_i,lower=-Q, upper=Q, y=x, rel.tol=1e-14)$value
  })))
}

library(lme4)
(model <- glmer(cbind(y,N-y)~1+(1|id), family=binomial))
MLE.glmer <- c(fixef(model), sqrt(VarCorr(model)$id[1]))
opt0 <- optim(MLE.glmer, negloglik, y=y, N=N, control=list(reltol=1e-50,maxit=10000)) 
MLE.optim <- opt0$par
MLE.glmer # MLEs from glmer
MLE.optim # MLEs from optim

L_i <- function(r,y,N,a,s) dbinom(y,size=N,prob=exp(a+r)/(1+exp(a+r)))*dnorm(r,0,s)

L1 <- integrate(L_i,lower=-100, upper=100, y=y[1], N=N[1], a=MLE.glmer[1], 
                s=MLE.glmer[2], rel.tol=1e-10)$value
L2 <- integrate(L_i, lower=-100, upper=100, y=y[2], N=N[2], a=MLE.glmer[1], 
                s=MLE.glmer[2], rel.tol=1e-10)$value

(log(L1)+log(L2)) # loglikelihood (manual computation)
logLik(model)     # loglikelihood from glmer 

Đặt giá trị cao nAGQtrong glmercuộc gọi đã tạo ra các MLE từ hai phương thức tương đương. Độ chính xác mặc định glmerkhông được tốt lắm. Điều này giải quyết vấn đề.

glmer(cbind(y,N-y)~1+(1|id),family=binomial,nAGQ=20)

Xem câu trả lời của @ SteveWalker tại đây Tại sao tôi không thể kết hợp đầu ra glmer (gia đình = nhị thức) với triển khai thủ công thuật toán Gauss-Newton? để biết thêm chi tiết.