R에서 lmer () 혼합 효과 모델의 예측 구간

lmer () 모델에서 예측 주위의 예측 간격을 얻고 싶습니다. 이에 대한 토론을 찾았습니다.

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

http://glmm.wikidot.com/faq

그러나 그들은 무작위 효과의 불확실성을 고려하지 않은 것으로 보인다.

구체적인 예는 다음과 같습니다. 나는 금붕어를 경주하고 있습니다. 지난 100 개 인종에 대한 데이터가 있습니다. RE 추정치와 FE 추정치의 불확실성을 고려하여 101st를 예측하고 싶습니다. 나는 물고기에 대한 임의의 가로 채기 (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

피쉬 D는 실제로 자신을 놓아 버렸으며 (1.11 온스) 실제로 피쉬 E와 피쉬 F를 잃을 것으로 예상됩니다. 그러나 이제 저는 "물고기 E (무게 0.91oz)가 물고기 D (무게 1.11oz)를 확률 p로 이길 것"이라고 말할 수 있기를 원합니다. lme4를 사용하여 그러한 진술을하는 방법이 있습니까? 확률 p가 고정 효과와 임의 효과 모두에서 내 불확실성을 고려하기를 원합니다.

감사!

추신 : predict.merMod문서를 보고 , 그것은 분산 변수에 불확실성을 통합하는 효율적인 방법을 정의하기 어렵 기 때문에 예측의 표준 오류를 계산할 수있는 옵션이 없다고 제안합니다. 우리 bootMer는이 작업에 권장 합니다 . bootMer이것을 사용하는 방법 . bootMer모수 추정치에 대한 부트 스트랩 신뢰 구간을 얻는 데 사용되는 것 같지만 잘못되었을 수 있습니다.

업데이트 된 Q :

좋아, 내가 틀린 질문을하고 있다고 생각한다. "무게가 무게 인 물고기 A는 시간의 90 % (lcl, ucl)의 경주 시간을 갖습니다."라고 말할 수 있기를 원합니다.

예제에서 1.0 oz 무게의 Fish A 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, 시뮬레이션을 다시 실행 및 사용 (아래 Ben 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 

이 간격이 너무 좁아 물고기 A의 평균 시간에 대한 신뢰 구간 인 것 같습니다. Fish A의 평균 레이스 시간이 아니라 관찰 된 레이스 시간에 대한 신뢰 구간을 원합니다. 어떻게 구할 수 있습니까?

업데이트 2, 거의 :

273 페이지 Gelman and Hill (2007) 에서 내가 찾던 것을 찾았다 고 생각했습니다 . 패키지 를 사용해야합니다 .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에 대한 나의 예측과 관련된 불확실성보다 훨씬 커야한다고 생각합니다.

Gelman and Hill 2007을 자세히 살펴볼 것입니다. 결국 BUGS (또는 Stan)로 전환해야 할 수도 있습니다.

세번째 업데이트 :

아마도 나는 사물을 잘못 개념화하고 있습니다. 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))

나는 두 개의 새로운 물고기를 추가했습니다. 995 개의 종족을 관찰 한 Fish K와 5 종의 종족을 관찰 한 Fish L. 우리는 Fish AJ에 대한 100 가지 경주를 관찰했습니다. lmer()전과 동일 하게 맞습니다 . 상기 찾고 dotplot()로부터 lattice패키지 :

기본적으로 dotplot()임의의 효과는 포인트 추정값으로 재정렬됩니다. 어류 L의 추정치는 최상위에 있으며 신뢰 구간이 매우 넓습니다. 물고기 K는 세 번째 줄에 있으며 신뢰 구간이 매우 좁습니다. 이것은 나에게 의미가 있습니다. Fish K에 대한 데이터는 많지만 Fish L에 대한 데이터는 많지 않으므로 Fish K의 실제 수영 속도에 대한 추측에 더 확신합니다. 이제는 이것을 사용하면 Fish K에 대한 좁은 예측 간격과 Fish L에 대한 넓은 예측 간격으로 이어질 것이라고 생각합니다 predictInterval(). 하우 바 :

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구성 요소 에서 원시 예측을 얻을 수 있습니다 .

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