ช่วงการทำนายสำหรับโมเดลเอฟเฟกต์ผสม lmer () ใน R

ฉันต้องการรับช่วงการทำนายรอบการทำนายจากโมเดล lmer () ฉันได้พบการสนทนาเกี่ยวกับเรื่องนี้:

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

http://glmm.wikidot.com/faq

แต่ดูเหมือนว่าพวกเขาจะไม่คำนึงถึงความไม่แน่นอนของเอฟเฟกต์แบบสุ่ม

นี่คือตัวอย่างที่เฉพาะเจาะจง ฉันแข่งปลาทอง ฉันมีข้อมูลในการแข่ง 100 ครั้งที่ผ่านมา ฉันต้องการที่จะคาดการณ์ลำดับที่ 101 โดยคำนึงถึงความไม่แน่นอนของการประมาณการ RE ของฉันและการประมาณ FE ฉันรวมถึงการสกัดกั้นแบบสุ่มสำหรับปลา (มี 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 ซึ่งทั้งคู่เคยดีกว่าในอดีต อย่างไรก็ตามตอนนี้ฉันอยากจะพูดว่า "Fish E (การชั่งน้ำหนัก 0.91oz) จะชนะ Fish D (การชั่งน้ำหนัก 1.11oz) ด้วยความน่าจะเป็น p" มีวิธีที่จะทำให้คำสั่งดังกล่าวใช้ lme4 หรือไม่? ฉันต้องการความน่าจะเป็นที่จะคำนึงถึงความไม่แน่นอนของฉันทั้งในเอฟเฟกต์คงที่และเอฟเฟกต์แบบสุ่ม

ขอบคุณ!

ป.ล. มองที่predict.merModเอกสารแนะนำว่า "ไม่มีตัวเลือกสำหรับการคำนวณข้อผิดพลาดมาตรฐานเนื่องจากเป็นการยากที่จะกำหนดวิธีการที่มีประสิทธิภาพซึ่งรวมความไม่แน่นอนในพารามิเตอร์ความแปรปรวนเราขอแนะนำbootMerสำหรับงานนี้" แต่โดยทั่วไปแล้วฉันไม่เห็น วิธีใช้bootMerเพื่อทำสิ่งนี้ ดูเหมือนว่าbootMerจะใช้ในการรับช่วงความเชื่อมั่นที่มีการบูตสำหรับการประมาณพารามิเตอร์ แต่ฉันอาจผิด

อัพเดท Q:

ตกลงฉันคิดว่าฉันกำลังถามคำถามผิด ฉันต้องการที่จะพูดว่า "ปลา A, ชั่งน้ำหนัก w oz, จะมีเวลาการแข่งขันที่ (lcl, ucl) 90% ของเวลา"

ในตัวอย่างที่ฉันวางไว้ Fish A ซึ่งมีน้ำหนัก 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 ถึง 10,000 ฉันยังคงได้รับผลลัพธ์ที่คล้ายกัน

ฉันจะทราบการ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 

ช่วงเวลานั้นแคบเกินไปและดูเหมือนจะเป็นช่วงความมั่นใจสำหรับเวลาเฉลี่ยของ Fish A ฉันต้องการช่วงความมั่นใจสำหรับเวลาการแข่งขันที่สังเกตได้ของ Fish A ไม่ใช่เวลาการแข่งขันเฉลี่ยของเขา ฉันจะได้รับสิ่งนั้นได้อย่างไร

อัปเดต 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 เผ่าพันธุ์ที่สังเกตได้สำหรับปลาเคและ 1,000 เผ่าพันธุ์ที่สังเกตได้สำหรับปลา L ฉันคิดว่าความไม่แน่นอนที่เกี่ยวข้องกับการทำนายปลา K นั้นน่าจะมีขนาดใหญ่กว่าความไม่แน่นอนที่เกี่ยวข้องกับการทำนายปลาแอล

จะดูเพิ่มเติมใน Gelman and Hill 2007 ฉันรู้สึกว่าฉันอาจต้องเปลี่ยนไปใช้ BUGS (หรือ Stan)

อัพเดทวันที่ 3:

บางทีฉันอาจจะคิดในสิ่งที่ไม่ดี การใช้predictInterval()ฟังก์ชั่นที่ได้รับจาก Jared Knowles ในคำตอบด้านล่างจะให้ช่วงเวลาที่ไม่ได้เป็นอย่างที่ฉันคาดไว้ ...

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 ครั้งสำหรับปลา AJ ฉันฟิตเหมือนlmer()เมื่อก่อน ดูdotplot()จากlatticeแพคเกจ:

ตามค่าเริ่มต้นdotplot()จัดเรียงเอฟเฟกต์แบบสุ่มตามการประเมินจุดใหม่ ค่าประมาณของปลา L อยู่ในอันดับต้น ๆ และมีช่วงความมั่นใจที่กว้างมาก Fish K อยู่ในบรรทัดที่สามและมีช่วงความมั่นใจแคบมาก เรื่องนี้ทำให้รู้สึกถึงฉัน เรามีข้อมูลมากมายเกี่ยวกับ Fish K แต่มีข้อมูลไม่มากเกี่ยวกับ Fish L ดังนั้นเราจึงมั่นใจมากขึ้นในการคาดเดาเกี่ยวกับความเร็วในการว่ายน้ำที่แท้จริงของ Fish K ตอนนี้ผมคิดว่าเรื่องนี้จะนำไปสู่ช่วงเวลาที่ทำนายแคบปลา K และช่วงเวลาที่ทำนายกว้างสำหรับปลา 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เป็นวิธีที่จะไป แต่สำหรับปัญหาบางอย่างมันเป็นไปไม่ได้ที่คำนวณได้เพื่อสร้าง bootstrapped refits ของตัวแบบทั้งหมด (ในกรณีที่ตัวแบบมีขนาดใหญ่)

ในกรณีเหล่านั้นpredictIntervalถูกออกแบบมาเพื่อใช้arm::simฟังก์ชั่นเพื่อสร้างการแจกแจงของพารามิเตอร์ในรูปแบบและจากนั้นใช้การแจกแจงเหล่านั้นเพื่อสร้างค่าจำลองของการตอบสนองที่ได้รับnewdataจากผู้ใช้ ใช้งานง่าย - สิ่งที่คุณต้องทำคือ:

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

คุณสามารถระบุโฮสต์ทั้งหมดของค่าอื่น ๆ เพื่อpredictIntervalรวมการตั้งค่าช่วงเวลาสำหรับช่วงเวลาการทำนายเลือกว่าจะรายงานค่าเฉลี่ยหรือค่ามัธยฐานของการแจกแจงและเลือกว่าจะรวมความแปรปรวนตกค้างจากโมเดลหรือไม่

มันไม่ใช่ช่วงการทำนายที่สมบูรณ์เพราะความแปรปรวนของthetaพารามิเตอร์ในlmerวัตถุนั้นไม่ได้รวมอยู่ แต่การเปลี่ยนแปลงอื่น ๆ ทั้งหมดจะถูกบันทึกด้วยวิธีนี้ซึ่งให้การประมาณที่ดีพอสมควร

ทำสิ่งนี้โดยbootMerสร้างชุดการคาดการณ์สำหรับแต่ละพารามิเตอร์การทำซ้ำ bootstrap:

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

ผลลัพธ์ของbootMerอยู่ในวัตถุที่ไม่โปร่งใส"boot"มาก แต่เราสามารถเอาการคาดการณ์ออกจาก$tส่วนประกอบได้

Fish E เอาชนะ Fish 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