Khoảng dự đoán cho mô hình hiệu ứng hỗn hợp lmer () trong R

Tôi muốn có được một khoảng dự đoán xung quanh một dự đoán từ mô hình lmer (). Tôi đã tìm thấy một số cuộc thảo luận về điều này:

http://rstudio-pub-static.s3.amazonaws.com/24365_2804ab8299934e888a60e7b16113f619.html

http://glmm.wikidot.com/faq

nhưng dường như họ không tính đến sự không chắc chắn của các hiệu ứng ngẫu nhiên.

Đây là một ví dụ cụ thể. Tôi đang đua cá vàng. Tôi có dữ liệu về 100 chủng tộc vừa qua. Tôi muốn dự đoán lần thứ 101, có tính đến sự không chắc chắn của các ước tính RE và ước tính FE. Tôi đang bao gồm một đánh chặn ngẫu nhiên cho cá (có 10 loại cá khác nhau) và hiệu ứng cố định cho trọng lượng (cá ít nặng hơn nhanh hơn).

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)

Bây giờ, để dự đoán cuộc đua thứ 101. Những con cá đã được cân và sẵn sàng để đi:

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 đã thực sự để mình ra đi (1,11 oz) và thực sự được dự đoán sẽ thua Fish E và Fish F, cả hai người mà anh ấy đã tốt hơn trong quá khứ. Tuy nhiên, bây giờ tôi muốn có thể nói, "Cá E (nặng 0,91oz) sẽ đánh bại Cá D (nặng 1,11oz) với xác suất p." Có cách nào để đưa ra tuyên bố như vậy bằng lme4 không? Tôi muốn xác suất p của tôi tính đến sự không chắc chắn của tôi trong cả hiệu ứng cố định và hiệu ứng ngẫu nhiên.

Cảm ơn!

PS nhìn vào predict.merModtài liệu này, nó cho thấy "Không có tùy chọn nào để tính toán các lỗi dự đoán tiêu chuẩn vì khó xác định một phương pháp hiệu quả kết hợp tính không chắc chắn trong các tham số phương sai; chúng tôi khuyên bạn nên bootMerthực hiện nhiệm vụ này", nhưng bằng cách golly, tôi không thể thấy Làm thế nào để sử dụng bootMerđể làm điều này. Có vẻ như bootMernó sẽ được sử dụng để có được khoảng tin cậy khởi động cho các ước tính tham số, nhưng tôi có thể sai.

CẬP NHẬT Q:

OK, tôi nghĩ rằng tôi đã hỏi sai câu hỏi. Tôi muốn có thể nói, "Cá A, nặng w oz, sẽ có thời gian đua là (lcl, ucl) 90% thời gian."

Trong ví dụ tôi đã đặt ra, Cá A, nặng 1,0 oz, sẽ có thời gian đua 9 + 0.1 + 1 = 10.1 sectrung bình, với độ lệch chuẩn là 0,1. Vì vậy, thời gian đua quan sát của anh ta sẽ ở giữa

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% thời gian. Tôi muốn một chức năng dự đoán cố gắng cho tôi câu trả lời. Đặt tất cả fishWt = 1.0vào newDat, chạy lại sim và sử dụng (như được đề xuất bởi Ben Bolker bên dưới)

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

cho

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

Điều này dường như thực sự được tập trung xung quanh mức trung bình dân số? Như thể nó không tính đến hiệu ứng FishID? Tôi nghĩ có lẽ đó là một vấn đề kích thước mẫu, nhưng khi tôi gặp phải số lượng các cuộc đua được quan sát từ 100 đến 10000, tôi vẫn nhận được kết quả tương tự.

Tôi sẽ lưu ý bootMersử dụng use.u=FALSEtheo mặc định. Mặt trái, sử dụng

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

cho

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

Khoảng thời gian đó quá hẹp và dường như là khoảng tin cậy cho thời gian trung bình của Fish A. Tôi muốn một khoảng tin cậy cho thời gian đua quan sát của Fish A, chứ không phải thời gian đua trung bình của anh ấy. Làm thế nào tôi có thể có được điều đó?

CẬP NHẬT 2, CÒN:

Tôi nghĩ rằng tôi đã tìm thấy những gì tôi đang tìm kiếm trong Gelman and Hill (2007) , trang 273. Cần sử dụng armgói.

library("arm")

Đối với cá 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 

Đối với tất cả các loài cá:

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 

Trên thực tế, đây có lẽ không phải là chính xác những gì tôi muốn. Tôi chỉ tính đến sự không chắc chắn của mô hình tổng thể. Trong một tình huống mà tôi có, giả sử, 5 chủng tộc quan sát được cho Cá K và 1000 chủng tộc được quan sát cho Cá L, tôi nghĩ rằng sự không chắc chắn liên quan đến dự đoán của tôi về Cá K nên lớn hơn nhiều so với sự không chắc chắn liên quan đến dự đoán của tôi đối với Cá L.

Sẽ nhìn xa hơn vào Gelman và Hill 2007. Tôi cảm thấy cuối cùng tôi phải chuyển sang BUGS (hoặc Stan).

CẬP NHẬT thứ 3:

Có lẽ tôi đang khái niệm hóa mọi thứ kém. Sử dụng predictInterval()chức năng được cung cấp bởi Jared Knowles trong câu trả lời dưới đây mang lại những khoảng thời gian không như tôi mong đợi ...

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

Tôi đã thêm hai con cá mới. Cá K, người mà chúng tôi đã quan sát 995 chủng tộc, và Cá L, người mà chúng tôi đã quan sát 5 chủng tộc. Chúng tôi đã quan sát 100 cuộc đua cho Cá AJ. Tôi phù hợp lmer()như trước đây. Nhìn vào dotplot()từ latticegói:

Theo mặc định, dotplot()sắp xếp lại các hiệu ứng ngẫu nhiên theo ước tính điểm của chúng. Ước tính cho Fish L nằm trên dòng trên cùng và có khoảng tin cậy rất rộng. Cá K nằm trên dòng thứ ba và có khoảng tin cậy rất hẹp. Điều này có ý nghĩa với tôi. Chúng tôi có rất nhiều dữ liệu về Fish K, nhưng không có nhiều dữ liệu về Fish L, vì vậy chúng tôi tự tin hơn vào dự đoán về tốc độ bơi thực sự của Fish K. Bây giờ, tôi nghĩ điều này sẽ dẫn đến một khoảng dự đoán hẹp cho Fish K và một khoảng dự đoán rộng cho Fish L khi sử dụng 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()

Tất cả các khoảng dự đoán đó dường như giống hệt nhau về chiều rộng. Tại sao dự đoán của chúng tôi về Cá K lại thu hẹp những người khác? Tại sao dự đoán của chúng tôi về Fish L rộng hơn những người khác?

Câu hỏi này và trao đổi tuyệt vời là động lực để tạo ra predictIntervalchức năng trong merToolsgói. bootMerlà con đường để đi, nhưng đối với một số vấn đề, việc tính toán khởi động lại toàn bộ mô hình là không khả thi (trong trường hợp mô hình lớn).

Trong các trường hợp đó, predictIntervalđược thiết kế để sử dụng các arm::simhàm để tạo phân phối các tham số trong mô hình và sau đó sử dụng các phân phối đó để tạo các giá trị mô phỏng của phản hồi newdatado người dùng cung cấp. Cách sử dụng đơn giản - tất cả những gì bạn cần làm là:

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

Bạn có thể chỉ định một loạt các giá trị khác để predictIntervalbao gồm đặt khoảng thời gian cho các khoảng dự đoán, chọn báo cáo giá trị trung bình hoặc trung bình của phân phối và chọn có bao gồm phương sai dư từ mô hình hay không.

Đây không phải là một khoảng dự đoán đầy đủ vì không bao gồm tính biến thiên của các thetatham số trong lmerđối tượng, nhưng tất cả các biến thể khác được ghi lại thông qua phương thức này, mang lại một xấp xỉ khá tốt.

Thực hiện việc này bằng cách bootMertạo một bộ dự đoán cho mỗi lần sao chép bootstrap tham số:

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

Đầu ra của bootMerlà trong một "boot"đối tượng không trong suốt , nhưng chúng ta có thể lấy các dự đoán thô ra khỏi $tthành phần.

Bao nhiêu thời gian để Cá E đánh bại Cá D?

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

Thời gian của cá E ở cột 5, thời gian của cá D ở cột 4, vì vậy chúng ta chỉ cần biết tỷ lệ mà cột 5 nhỏ hơn cột 4:

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