Warum erreicht glmer nicht die maximale Wahrscheinlichkeit (wie durch weitere generische Optimierung überprüft)?

Numerisch die Ableitung MLE s von GLMM schwierig ist und in der Praxis, ich weiß, wir sollten nicht Brute - Force - Optimierung verwenden (zB mit optimauf einfache Art und Weise). Aus pädagogischen Gründen möchte ich es jedoch versuchen, um sicherzustellen, dass ich das Modell richtig verstehe (siehe folgenden Code). Ich habe festgestellt, dass ich immer inkonsistente Ergebnisse erhalte glmer().

Insbesondere, auch wenn ich die MLEs von glmerals Anfangswerte verwende, handelt es sich gemäß der von mir geschriebenen Likelihood-Funktion ( negloglik) nicht um MLEs ( opt1$valueist kleiner als opt2). Ich denke, zwei mögliche Gründe sind:

1. negloglik ist nicht gut geschrieben, so dass es zu viele numerische Fehler gibt, und
2. Die Modellspezifikation ist falsch. Für die Modellspezifikation ist das beabsichtigte Modell:

$$\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}$$ wobei ein binomisches pmf und ein normales pdf ist. Ich versuche , und zu schätzen . Insbesondere möchte ich wissen, ob die Modellspezifikation falsch ist, was die korrekte Spezifikation ist.$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...

Ein einfacheres Beispiel

Um die Wahrscheinlichkeit eines großen numerischen Fehlers zu verringern, habe ich ein einfacheres Beispiel erstellt.

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 

Durch das Festlegen eines hohen Werts nAGQin dem glmerAufruf wurden die MLEs aus den beiden Methoden gleichwertig. Die Standardgenauigkeit von glmerwar nicht sehr gut. Damit ist das Problem behoben.

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

Siehe @ SteveWalkers Antwort hier. Warum kann ich die glmer (family = binomial) Ausgabe nicht mit der manuellen Implementierung des Gauss-Newton-Algorithmus in Einklang bringen? für mehr Details.