Perché glmer non raggiunge la massima probabilità (come verificato applicando un'ulteriore ottimizzazione generica)?

Derivare numericamente gli MLE di GLMM è difficile e, in pratica, lo so, non dovremmo usare l'ottimizzazione della forza bruta (ad esempio, usando optimin modo semplice). Ma per il mio scopo educativo, voglio provarlo per assicurarmi di capire correttamente il modello (vedi il codice qui sotto). Ho scoperto che ottengo sempre risultati incoerenti da glmer().

In particolare, anche se uso gli MLE glmercome valori iniziali, in base alla funzione di probabilità che ho scritto ( negloglik), non sono MLE ( opt1$valueè più piccolo di opt2). Penso che due potenziali motivi siano:

1. negloglik non è scritto bene in modo che ci sia troppo errore numerico in esso, e
2. le specifiche del modello sono errate. Per le specifiche del modello, il modello previsto è:

$$\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}$$ dove è un pmf binomiale è un normale pdf. Sto cercando di stimare , e . In particolare, voglio sapere se la specifica del modello è errata, qual è la specifica corretta.$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...

Un esempio più semplice

Per ridurre la possibilità di avere un grande errore numerico, ho creato un esempio più semplice.

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 

L'impostazione di un valore elevato nAGQnella glmerchiamata ha reso equivalenti gli MLE dai due metodi. La precisione predefinita di glmernon era molto buona. Questo risolve il problema.

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

Vedi la risposta di @ SteveWalker qui Perché non riesco ad abbinare l'output glmer (family = binomial) con l'implementazione manuale dell'algoritmo Gauss-Newton? per ulteriori dettagli.