Intervallo di predizione per il modello di effetti misti lmer () in R

Voglio ottenere un intervallo di previsione attorno a una previsione da un modello lmer (). Ho trovato alcune discussioni su questo:

http://rstudio-pubs-static.s3.amazonaws.com/24365_2803ab8299934e888a60e7b16113f619.html

http://glmm.wikidot.com/faq

ma sembrano non tenere conto dell'incertezza degli effetti casuali.

Ecco un esempio specifico. Sto correndo pesce d'oro. Ho dei dati sulle ultime 100 gare. Voglio prevedere il 101 °, tenendo conto dell'incertezza delle mie stime di RE e delle stime di FE. Sto includendo un'intercettazione casuale per i pesci (ci sono 10 pesci diversi) e un effetto fisso per il peso (i pesci meno pesanti sono più veloci).

library("lme4")

fish <- as.factor(rep(letters[1:10], each=100))
race <- as.factor(rep(900:999, 10))
oz <- round(1 + rnorm(1000)/10, 3)
sec <- 9 + rep(1:10, rep(100,10))/10 + oz + rnorm(1000)/10

fishDat <- data.frame(fishID = fish, 
      raceID = race, fishWt = oz, time = sec)
head(fishDat)
plot(fishDat$fishID, fishDat$time)

lme1 <- lmer(time ~ fishWt + (1 | fishID), data=fishDat)
summary(lme1)

Ora, per prevedere la 101a gara. I pesci sono stati pesati e sono pronti per partire:

newDat <- data.frame(fishID = letters[1:10], 
    raceID = rep(1000, 10),
    fishWt = 1 + round(rnorm(10)/10, 3))
newDat$pred <- predict(lme1, newDat)
newDat

   fishID raceID fishWt     pred
1       a   1000  1.073 10.15348
2       b   1000  1.001 10.20107
3       c   1000  0.945 10.25978
4       d   1000  1.110 10.51753
5       e   1000  0.910 10.41511
6       f   1000  0.848 10.44547
7       g   1000  0.991 10.68678
8       h   1000  0.737 10.56929
9       i   1000  0.993 10.89564
10      j   1000  0.649 10.65480

Fish D si è davvero lasciato andare (1,11 oz) e si prevede in realtà di perdere contro Fish E e Fish F, entrambi i quali è stato migliore rispetto al passato. Tuttavia, ora voglio poter dire "Il pesce E (che pesa 0.91oz) batterà il pesce D (che pesa 1.11oz) con probabilità p." C'è un modo per fare una simile affermazione usando lme4? Voglio che la mia probabilità p tenga conto della mia incertezza sia nell'effetto fisso sia nell'effetto casuale.

Grazie!

PS, guardando la predict.merModdocumentazione, suggerisce "Non esiste alcuna opzione per calcolare gli errori standard delle previsioni perché è difficile definire un metodo efficiente che incorpori l'incertezza nei parametri di varianza; raccomandiamo bootMerper questo compito", ma a malincuore non riesco a vedere come usare bootMerper fare questo. Sembra che bootMersarebbe usato per ottenere intervalli di confidenza bootstrap per le stime dei parametri, ma potrei sbagliarmi.

Q AGGIORNATO:

OK, penso di aver fatto la domanda sbagliata. Voglio poter dire "Il pesce A, che pesa oz, avrà un tempo di gara che è (lcl, ucl) il 90% delle volte."

Nell'esempio che ho esposto, il pesce A, del peso di 1,0 once, avrà un tempo di gara 9 + 0.1 + 1 = 10.1 secin media, con una deviazione standard di 0,1. Pertanto, il tempo di gara osservato sarà tra

x <- rnorm(mean = 10.1, sd = 0.1, n=10000)
quantile(x, c(0.05,0.50,0.95))
       5%       50%       95% 
 9.938541 10.100032 10.261243 

90% delle volte. Voglio una funzione di previsione che tenti di darmi quella risposta. Impostare all fishWt = 1.0in newDat, rieseguire la sim e usare (come suggerito da Ben Bolker di seguito)

predFun <- function(fit) {
  predict(fit,newDat)
}
bb <- bootMer(lme1,nsim=1000,FUN=predFun, use.u = FALSE)
predMat <- bb$t

dà

> quantile(predMat[,1], c(0.05,0.50,0.95))
      5%      50%      95% 
10.01362 10.55646 11.05462 

Questo sembra effettivamente incentrato sulla media della popolazione? Come se non stesse prendendo in considerazione l'effetto FishID? Ho pensato che forse fosse un problema di dimensioni del campione, ma quando ho aumentato il numero di gare osservate da 100 a 10000, ho ancora risultati simili.

Prenderò nota degli bootMerusi use.u=FALSEdi default. D'altro canto, usando

bb <- bootMer(lme1,nsim=1000,FUN=predFun, use.u = TRUE)

dà

> quantile(predMat[,1], c(0.05,0.50,0.95))
      5%      50%      95% 
10.09970 10.10128 10.10270 

Tale intervallo è troppo stretto e sembrerebbe un intervallo di confidenza per il tempo medio di Fish A. Voglio un intervallo di confidenza per il tempo di gara osservato di Fish A, non per il suo tempo di gara medio. Come posso ottenerlo?

AGGIORNAMENTO 2, QUASI:

Ho pensato che ho trovato quello che cercavo in Gelman e Hill (2007) , pagina 273. bisogno di utilizzare il armpacchetto.

library("arm")

Per i pesci A:

x.tilde <- 1    #observed fishWt for new race
sigma.y.hat <- sigma.hat(lme1)$sigma$data        #get uncertainty estimate of our model
coef.hat <- as.matrix(coef(lme1)$fishID)[1,]    #get intercept (random) and fishWt (fixed) parameter estimates
y.tilde <- rnorm(1000, coef.hat %*% c(1, x.tilde), sigma.y.hat) #simulate
quantile (y.tilde, c(.05, .5, .95))

  5%       50%       95% 
 9.930695 10.100209 10.263551 

Per tutti i pesci:

x.tilde <- rep(1,10)  #assume all fish weight 1 oz
#x.tilde <- 1 + rnorm(10)/10  #alternatively, draw random weights as in original example
sigma.y.hat <- sigma.hat(lme1)$sigma$data
coef.hat <- as.matrix(coef(lme1)$fishID)
y.tilde <- matrix(rnorm(1000, coef.hat %*% matrix(c(rep(1,10), x.tilde), nrow = 2 , byrow = TRUE), sigma.y.hat), ncol = 10, byrow = TRUE)
quantile (y.tilde[,1], c(.05, .5, .95))
       5%       50%       95% 
 9.937138 10.102627 10.234616 

In realtà, questo probabilmente non è esattamente quello che voglio. Sto solo prendendo in considerazione l'incertezza complessiva del modello. In una situazione in cui ho, per esempio, 5 razze osservate per Fish K e 1000 razze osservate per Fish L, penso che l'incertezza associata alla mia previsione per Fish K dovrebbe essere molto più grande dell'incertezza associata alla mia previsione per Fish L.

Esaminerò ulteriormente Gelman e Hill 2007. Sento che potrei finire per passare a BUGS (o Stan).

AGGIORNA IL 3 °:

Forse sto concettualizzando le cose male. L'uso della predictInterval()funzione data da Jared Knowles in una risposta di seguito fornisce intervalli che non sono esattamente quello che mi aspetterei ...

library("lattice")
library("lme4")
library("ggplot2")

fish <- c(rep(letters[1:10], each = 100), rep("k", 995), rep("l", 5))
oz <- round(1 + rnorm(2000)/10, 3)
sec <- 9 + c(rep(1:10, each = 100)/10,rep(1.1, 995), rep(1.2, 5)) + oz + rnorm(2000)

fishDat <- data.frame(fishID = fish, fishWt = oz, time = sec)
dim(fishDat)
head(fishDat)
plot(fishDat$fishID, fishDat$time)

lme1 <- lmer(time ~ fishWt + (1 | fishID), data=fishDat)
summary(lme1)
dotplot(ranef(lme1, condVar = TRUE))

Ho aggiunto due nuovi pesci. Fish K, per il quale abbiamo osservato 995 razze, e Fish L, per il quale abbiamo osservato 5 razze. Abbiamo osservato 100 gare per Fish AJ. Mi adatto lmer()come prima. Guardando dotplot()dal latticepacchetto:

Per impostazione predefinita, dotplot()riordina gli effetti casuali in base alla loro stima puntuale. La stima per Fish L è nella riga superiore e ha un intervallo di confidenza molto ampio. Il pesce K si trova sulla terza linea e ha un intervallo di confidenza molto stretto. Questo ha senso per me. Abbiamo molti dati su Fish K, ma non molti su Fish L, quindi siamo più fiduciosi nel nostro pronostico sulla reale velocità di nuoto di Fish K. Ora, penso che ciò porterebbe a un intervallo di previsione ristretto per Fish K e ad un ampio intervallo di previsione per Fish L durante l'utilizzo predictInterval(). Howeva:

newDat <- data.frame(fishID = letters[1:12],
                     fishWt = 1)

preds <- predictInterval(lme1, newdata = newDat, n.sims = 999)
preds
ggplot(aes(x=letters[1:12], y=fit, ymin=lwr, ymax=upr), data=preds) +
  geom_point() + 
  geom_linerange() +
  labs(x="Index", y="Prediction w/ 95% PI") + theme_bw()

Tutti questi intervalli di previsione sembrano essere identici in larghezza. Perché la nostra previsione per Fish K non è più stretta delle altre? Perché la nostra previsione per Fish L non è più ampia di altre?

Questa domanda e lo scambio eccellente sono stati l'impulso per la creazione della predictIntervalfunzione nel merToolspacchetto. bootMerè la strada da percorrere, ma per alcuni problemi non è fattibile dal punto di vista computazionale generare refit bootstrap di tutto il modello (nei casi in cui il modello è grande).

In questi casi, predictIntervalè progettato per utilizzare le arm::simfunzioni per generare distribuzioni di parametri nel modello e quindi per utilizzare tali distribuzioni per generare valori simulati della risposta newdataforniti dall'utente. È semplice da usare - tutto ciò che dovresti fare è:

library(merTools)
preds <- predictInterval(lme1, newdata = newDat, n.sims = 999)

È possibile specificare un intero host di altri valori per predictIntervalincludere l'impostazione dell'intervallo per gli intervalli di previsione, la scelta se indicare la media o la mediana della distribuzione e la scelta se includere o meno la varianza residua dal modello.

Non è un intervallo di previsione completo perché la variabilità dei thetaparametri lmernell'oggetto non è inclusa, ma tutte le altre variazioni vengono acquisite con questo metodo, fornendo un'approssimazione abbastanza decente.

Fallo bootMergenerando una serie di previsioni per ogni replica parametrica del bootstrap:

predFun <- function(fit) {
    predict(fit,newDat)
}
bb <- bootMer(lme1,nsim=200,FUN=predFun,seed=101)

L'output di bootMerè in un oggetto non terribilmente trasparente "boot", ma possiamo estrarre le previsioni grezze dal $tcomponente.

Per quanto tempo Fish E batte Fish D?

predMat <- bb$t
dim(predMat) ## 200 rows (PB reps) x 10 (predictions)

I tempi dei pesci E sono nella colonna 5, i tempi dei pesci D sono nella colonna 4, quindi dobbiamo solo sapere la proporzione che la colonna 5 è inferiore alla colonna 4:

mean(predMat[,5]<predMat[,4])  ## 0.57