Інтервал прогнозування для lmer () моделі змішаних ефектів в R

Я хочу отримати інтервал прогнозування навколо прогнозування з lmer () моделі. Я знайшов певну дискусію з цього приводу:

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

http://glmm.wikidot.com/faq

але вони, схоже, не враховують невизначеність випадкових ефектів.

Ось конкретний приклад. Я скачу золоту рибку. У мене є дані про останні 100 гонок. Я хочу передбачити 101-й, беручи до уваги невизначеність моїх оцінок РЕ та оцінок ЗП. Я включаю випадковий перехоплення риби (є 10 різних риб) і фіксований ефект для ваги (менш важкі риби швидше).

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)

Тепер передбачити 101-ту гонку. Рибу зважили і готові до поїздки:

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 насправді відпустив себе (1,11 унції) і насправді прогнозується, що він програє Fish E та Fish F, обом він був кращим, ніж у минулому. Однак зараз я хочу мати можливість сказати: "Риба E (вагою 0,91 унції) буде бити рибу D (вагою 1,11 унції) з імовірністю p." Чи є спосіб зробити таке твердження за допомогою lme4? Я хочу, щоб моя ймовірність p враховувала мою невизначеність як у фіксованому ефекті, так і у випадковому ефекті.

Спасибі!

PS, дивлячись на predict.merModдокументацію, пропонує: "Немає можливості для обчислення стандартних помилок прогнозування, тому що важко визначити ефективний метод, що включає в себе невизначеність параметрів дисперсії; ми рекомендуємо bootMerдля цього завдання", але, боже, я не бачу як bootMerце зробити для цього. Здається bootMer, буде використано для завантаження довірчих інтервалів для оцінки параметрів, але я можу помилитися.

ОНОВЛЕНО Q:

Гаразд, я думаю, що я задав неправильне запитання. Я хочу, щоб я міг сказати: "Риба A, яка важить w oz, матиме час гонки, який становить (lcl, ucl) 90% часу".

У прикладі, який я виклав, риба А, вагою 1,0 унції, буде мати 9 + 0.1 + 1 = 10.1 secсередній час гонки в середньому зі стандартним відхиленням 0,1. Таким чином, його спостережуваний час гонки буде між

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% часу. Я хочу функцію передбачення, яка намагається дати мені цю відповідь. Установка всіх fishWt = 1.0ін newDat, повторно запустити сім, і використовуючи (як це було запропоновано Бен Bolker нижче)

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

дає

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

Це, здається, насправді зосереджено навколо середнього показника чисельності населення? Наче це не враховує ефект FishID? Я думав, що це може бути проблема вибірки, але коли я збільшив кількість спостережуваних гонок від 100 до 10000, я все одно отримую подібні результати.

Зауважу, bootMerвикористання use.u=FALSEза замовчуванням. На зворотному боці, використовуючи

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

дає

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

Цей інтервал занадто вузький, і, здається, буде довірчим інтервалом для середнього часу Риби А. Я хочу інтервал довіри для спостережуваного часу гонки Риби А, а не його середнього часу гонки. Як я можу це отримати?

ОНОВЛЕННЯ 2, БІЛЬШЕ:

Я думав, що знайшов те, що шукав у Gelman and Hill (2007) , стор. 273. Потрібно використовувати armпакет.

library("arm")

Для риб 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 

Для всіх риб:

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 

Власне, це, мабуть, не саме те, що я хочу. Я враховую лише загальну невизначеність моделі. У ситуації, коли у мене, скажімо, 5 спостережуваних гонок для Fish K та 1000 спостережуваних гонок для Fish L, я вважаю, що невизначеність, пов’язана з моїм прогнозом на Fish K, повинна бути набагато більшою, ніж невизначеність, пов'язана з моїм прогнозом на Fish L.

Подивимось далі на Гельмана та Хілл 2007. Я відчуваю, що мені в кінцевому підсумку доведеться перейти на КУПИ (або Стен).

ОНОВЛЕННЯ 3-го:

Можливо, я погано осмислюю речі. Використання predictInterval()функції, яку Джаред Ноулс отримав у відповіді нижче, дає інтервали, які не зовсім те, що я очікував ...

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

Я додав двох нових риб. Fish K, за яким ми спостерігали 995 забігів, і Fish L, за яким ми спостерігали 5 рас. Ми спостерігали 100 гонок за Fish AJ. Я підходжу так само, lmer()як і раніше. Дивлячись на пакет dotplot()із latticeпакета:

За замовчуванням dotplot()переставляє випадкові ефекти за їх бальною оцінкою. Оцінка для Fish L знаходиться на верхній лінії та має дуже широкий інтервал довіри. Fish K знаходиться на третьому рядку і має дуже вузький інтервал довіри. Це має для мене сенс. У нас є багато даних про Fish K, але не так багато даних про Fish L, тому ми впевнені у своїх здогадах про справжню швидкість плавання Fish K. Тепер я думаю, що це призведе до вузького інтервалу прогнозування для Fish K та широкого інтервалу прогнозування для Fish L при використанні 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()

Усі ці інтервали прогнозування здаються однаковими по ширині. Чому наше передбачення для Fish K не звужує інших? Чому наш прогноз на Fish L не ширший за інших?

Це питання та чудовий обмін послужили поштовхом до створення predictIntervalфункції вmerTools пакеті. bootMerце шлях, але для деяких проблем не представляється можливим обчислювально генерувати завантажені оновлення всієї моделі (у випадках, коли модель велика).

У цих випадках predictIntervalпризначений для використання arm::simфункцій для генерації розподілів параметрів в моделі, а потім для використання цих розподілів для генерації імітованих значень відповіді, newdataнаданих користувачем. У використанні це просто - все, що вам потрібно буде зробити:

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

Ви можете вказати цілу низку інших значень predictInterval включаючи встановлення інтервалу для інтервалів прогнозування, вибираючи, чи повідомляти середнє або медіану розподілу, і вибирати, включити чи не залишкову дисперсію від моделі.

Це не повний інтервал передбачення, оскільки мінливість thetaпараметрів в lmerоб'єкті не включена, але всі інші зміни відображаються за допомогою цього методу, даючи досить пристойне наближення.

Зробіть це, зробивши bootMerгенерувати набір прогнозів для кожної параметричної копії завантажувача:

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

Вихідні дані bootMerзнаходяться в не дуже прозорому "boot"об'єкті, але ми можемо отримати непрості прогнози$t компонента.

Скільки часу риба Е перемагає рибу D?

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

Часи риб E є у графі 5, а риби D - у графі 4, тому нам просто потрібно знати, що частка 5 менша, ніж колонка 4:

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