Intervalo de previsão para o modelo de efeitos mistos lmer () em R

Quero obter um intervalo de previsão em torno de uma previsão de um modelo lmer (). Eu encontrei alguma discussão sobre isso:

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

http://glmm.wikidot.com/faq

mas eles parecem não levar em consideração a incerteza dos efeitos aleatórios.

Aqui está um exemplo específico. Eu estou correndo peixe dourado. Eu tenho dados das últimas 100 corridas. Quero prever o 101º, levando em consideração a incerteza de minhas estimativas de ER e de EF. Estou incluindo uma interceptação aleatória para peixes (existem 10 peixes diferentes) e efeito fixo para o peso (peixes menos pesados ​​são mais rápidos).

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)

Agora, para prever a 101ª corrida. Os peixes foram pesados ​​e estão prontos para ir:

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

O Fish D realmente se soltou (1,11 oz) e, na verdade, está previsto perder para o Fish E e o Fish F, ambos com quem ele foi melhor do que no passado. No entanto, agora eu quero poder dizer: "O peixe E (pesando 0,91oz) vence o peixe D (pesando 1,11oz) com probabilidade p". Existe uma maneira de fazer essa declaração usando o lme4? Quero que minha probabilidade p leve em consideração minha incerteza tanto no efeito fixo quanto no efeito aleatório.

Obrigado!

O PS, olhando para a predict.merModdocumentação, sugere "Não há opção para calcular erros padrão de previsões porque é difícil definir um método eficiente que incorpore incerteza nos parâmetros de variação; recomendamos bootMerpara esta tarefa", mas, caramba, não consigo ver como usar bootMerpara fazer isso. Parece bootMerque seria usado para obter intervalos de confiança de inicialização para estimativas de parâmetros, mas eu posso estar errado.

ATUALIZADO Q:

OK, acho que estava fazendo a pergunta errada. Eu quero poder dizer: "O peixe A, pesando onças, terá um tempo de corrida que é (lcl, ucl) 90% do tempo".

No exemplo que descrevi, o peixe A, pesando 1,0 oz, terá um tempo de corrida 9 + 0.1 + 1 = 10.1 secem média, com um desvio padrão de 0,1. Assim, o tempo de corrida observado será entre

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% do tempo. Quero uma função de previsão que tente me dar essa resposta. Definir tudo fishWt = 1.0em newDat, re-executar o sim, e usando (como sugerido por Ben Bolker abaixo)

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 

Isso parece realmente estar centrado em torno da média da população? Como se não estivesse levando em consideração o efeito FishID? Eu pensei que talvez fosse um problema de tamanho de amostra, mas quando aumentamos o número de corridas observadas de 100 para 10000, ainda recebo resultados semelhantes.

Vou notar bootMerusos use.u=FALSEpor padrão. Por outro lado, 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 

Esse intervalo é muito estreito e parece ser um intervalo de confiança para o tempo médio do Peixe A. Quero um intervalo de confiança para o tempo de corrida observado no Fish A, não para o tempo médio de corrida. Como posso conseguir isso?

ATUALIZAÇÃO 2, QUASE:

Eu pensei que eu encontrei o que estava procurando em Gelman e Hill (2007) , página 273. necessidade de utilizar o armpacote.

library("arm")

Para peixes 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 

Para todos os peixes:

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 

Na verdade, isso provavelmente não é exatamente o que eu quero. Estou apenas levando em consideração a incerteza geral do modelo. Em uma situação em que, digamos, 5 corridas observadas para o Peixe K e 1000 corridas observadas para o Peixe L, acho que a incerteza associada à minha previsão para o Peixe K deve ser muito maior do que a incerteza associada à minha previsão para o Peixe L.

Analisarei mais detalhadamente Gelman e Hill 2007. Acho que posso acabar tendo que mudar para o BUGS (ou Stan).

ATUALIZE O 3º:

Talvez eu esteja conceituando mal as coisas. Usar a predictInterval()função dada por Jared Knowles em uma resposta abaixo fornece intervalos que não são exatamente o que eu esperaria ...

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))

Eu adicionei dois novos peixes. Peixe K, para quem observamos 995 raças, e Peixe L, para quem observamos 5 raças. Observamos 100 corridas para o Fish AJ. Eu me encaixo da mesma maneira lmer()que antes. Olhando para dotplot()o latticepacote:

Por padrão, dotplot()reordena os efeitos aleatórios pela estimativa de pontos. A estimativa para o peixe L está na linha superior e possui um intervalo de confiança muito amplo. O peixe K está na terceira linha e possui um intervalo de confiança muito estreito. Isso faz sentido para mim. Temos muitos dados sobre o Fish K, mas não muitos sobre o Fish L, por isso estamos mais confiantes em nossa estimativa sobre a verdadeira velocidade de natação do Fish K. Agora, eu acho que isso levaria a um intervalo de previsão estreito para o Fish K e a um amplo intervalo de previsão para o Fish L ao usar 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()

Todos esses intervalos de previsão parecem ter largura idêntica. Por que nossa previsão para Fish K não é mais restritiva que as outras? Por que nossa previsão para o Fish L não é mais ampla que outras?

Essa pergunta e excelente troca foram o ímpeto para criar a predictIntervalfunção no merToolspacote. bootMeré o caminho a percorrer, mas para alguns problemas não é viável computacionalmente gerar reajustes de inicialização de todo o modelo (nos casos em que o modelo é grande).

Nesses casos, predictIntervalé projetado para usar as arm::simfunções para gerar distribuições de parâmetros no modelo e, em seguida, usá-las para gerar valores simulados da resposta newdatafornecida pelo usuário. É simples de usar - tudo o que você precisa fazer é:

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

Você pode especificar toda uma série de outros valores para predictIntervalincluir a definição do intervalo para os intervalos de previsão, escolher se deve reportar a média ou mediana da distribuição e escolher se deve ou não incluir a variação residual do modelo.

Não é um intervalo de previsão completo porque a variabilidade dos thetaparâmetros no lmerobjeto não está incluída, mas todas as outras variações são capturadas por esse método, fornecendo uma aproximação bastante decente.

Faça isso bootMergerando um conjunto de previsões para cada replicação de inicialização paramétrica:

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

A saída de bootMerestá em um "boot"objeto não muito transparente , mas podemos obter as previsões brutas do $tcomponente.

Quanto tempo o Fish E vence o Fish D?

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

Os tempos do peixe E estão na coluna 5, os tempos do peixe D estão na coluna 4, portanto, apenas precisamos saber a proporção em que a coluna 5 é menor que a coluna 4:

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