로지스틱 회귀 분석에서 예측 된 확률에 대한 신뢰 구간 표시

좋아, 나는 로지스틱 회귀를 가지고 predict()있으며 내 추정값을 기반으로 확률 곡선을 개발하는 함수를 사용했습니다 .

## LOGIT MODEL:
library(car)
mod1 = glm(factor(won) ~ as.numeric(bid), data=mydat, family=binomial(link="logit"))

## PROBABILITY CURVE:
all.x <- expand.grid(won=unique(won), bid=unique(bid))
y.hat.new <- predict(mod1, newdata=all.x, type="response")
plot(bid<-000:1000,predict(mod1,newdata=data.frame(bid<-c(000:1000)),type="response"), lwd=5, col="blue", type="l")

이것은 훌륭하지만 확률에 대한 신뢰 구간을 그리는 것이 궁금합니다. 시도 plot.ci()했지만 운이 없었습니다. 누구나 car패키지 또는 기본 R을 사용 하여이 작업을 수행 할 수있는 방법을 알려 줄 수 있습니까?

사용한 코드는 glm함수를 사용하여 로지스틱 회귀 모형을 추정 합니다. 당신은 데이터를 포함하지 않았기 때문에, 나는 단지 약간을 구성 할 것입니다.

set.seed(1234)
mydat <- data.frame(
    won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
    bid=runif(250, min=0, max=1000)
)
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))

로지스틱 회귀 모델은 이항 반응 변수와이 경우 하나의 연속 예측 변수 간의 관계를 모델링합니다. 결과는 예측 변수와 선형 관계인 로짓 변환 확률입니다. 귀하의 경우, 결과는 도박에서이기거나 이기지 않는 것에 대한 이진 반응이며 베팅의 가치에 의해 예측됩니다. 의 계수 mod1는 다음과 같이 로그 확률 (로그인하기 어려운)로 제공됩니다.

기록 된 확률을 확률로 변환하기 위해 위의 값을

이 정보를 사용하여 플롯을 설정할 수 있습니다. 먼저 예측 변수의 범위가 필요합니다.

plotdat <- data.frame(bid=(0:1000))

그런 다음을 사용 predict하여 모델을 기반으로 예측을 얻을 수 있습니다

preddat <- predict(mod1, newdata=plotdat, se.fit=TRUE)

피팅 된 값은 다음을 통해서도 얻을 수 있습니다.

mod1$fitted

를 지정 se.fit=TRUE하면 각 적합치와 관련된 표준 오차도 얻을 수 있습니다. 결과 data.frame는 적합치 예측 ( fit), 추정 표준 오차 ( se.fit) 및 표준 오차를 계산하는 데 사용 된 분산의 제곱근을 제공하는 스칼라 ( )를 갖는 행렬입니다 residual.scale. 이항 로짓의 경우, 값이 1 할 것이다 (만약 입력하여 볼 수있는 preddat$residual.scale에서 R). 지금까지 계산 한 예를 보려면을 입력하십시오 head(data.frame(preddat)).

다음 단계는 플롯을 설정하는 것입니다. 먼저 매개 변수를 사용하여 빈 플로팅 영역을 설정하고 싶습니다.

with(mydat, plot(bid, won, type="n", 
    ylim=c(0, 1), ylab="Probability of winning", xlab="Bid"))

이제 적합 확률을 계산하는 방법을 아는 것이 중요하다는 것을 알 수 있습니다. 위의 두 번째 공식에 따라 적합 확률에 해당하는 선을 그릴 수 있습니다. 를 사용하면 preddat data.frame적합치 값을 확률로 변환하고이를 사용하여 예측 변수 값에 대한 선을 그릴 수 있습니다.

with(preddat, lines(0:1000, exp(fit)/(1+exp(fit)), col="blue"))

마지막으로, 질문에 답하십시오. 적합치에 +/- 1.96대한 표준 오차 의 확률을 표준 오차 로 계산하여 신뢰 구간을 그림에 추가 할 수 있습니다 .

with(preddat, lines(0:1000, exp(fit+1.96*se.fit)/(1+exp(fit+1.96*se.fit)), lty=2))
with(preddat, lines(0:1000, exp(fit-1.96*se.fit)/(1+exp(fit-1.96*se.fit)), lty=2))

무작위로 생성 된 데이터의 결과 플롯은 다음과 같아야합니다.

편의를 위해 다음은 한 덩어리의 모든 코드입니다.

set.seed(1234)
mydat <- data.frame(
    won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
    bid=runif(250, min=0, max=1000)
)
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))
plotdat <- data.frame(bid=(0:1000))
preddat <- predict(mod1, newdata=plotdat, se.fit=TRUE)
with(mydat, plot(bid, won, type="n", 
    ylim=c(0, 1), ylab="Probability of winning", xlab="Bid"))
with(preddat, lines(0:1000, exp(fit)/(1+exp(fit)), col="blue"))
with(preddat, lines(0:1000, exp(fit+1.96*se.fit)/(1+exp(fit+1.96*se.fit)), lty=2))
with(preddat, lines(0:1000, exp(fit-1.96*se.fit)/(1+exp(fit-1.96*se.fit)), lty=2))

(참고 : 이것은 stats.stackexchange와 관련성을 높이기 위해 심하게 편집 된 답변입니다.)

다음은 @smillig 솔루션의 수정 사항입니다. 여기서 tidyverse 도구를 사용 linkinv하고 GLM 모델 객체의 일부인 함수 도 사용 합니다 mod1. 이렇게하면 물류 기능을 수동으로 반전시킬 필요가 없으며,이 방법은 적합한 특정 GLM에 관계없이 작동합니다.

library(tidyverse)
library(magrittr)


set.seed(1234)

# create fake data on gambling. Does prob win depend on bid size? 
mydat <- data.frame(
  won=as.factor(sample(c(0, 1), 250, replace=TRUE)), 
  bid=runif(250, min=0, max=1000)
)

# logistic regression model: 
mod1 <- glm(won~bid, data=mydat, family=binomial(link="logit"))

# new predictor values to use for prediction: 
plotdat <- data.frame(bid=(0:1000))

# df with predictions, lower and upper limits of CIs: 
preddat <- predict(mod1,
               type = "link",
               newdata=plotdat,
               se.fit=TRUE) %>% 
  as.data.frame() %>% 
  mutate(bid = (0:1000), 

         # model object mod1 has a component called linkinv that 
         # is a function that inverts the link function of the GLM:
         lower = mod1$family$linkinv(fit - 1.96*se.fit), 
         point.estimate = mod1$family$linkinv(fit), 
         upper = mod1$family$linkinv(fit + 1.96*se.fit)) 


# plotting with ggplot: 
preddat %>% ggplot(aes(x = bid, 
                   y = point.estimate)) + 
  geom_line(colour = "blue") + 
  geom_ribbon(aes(ymin = lower,
                  ymax = upper), 
              alpha = 0.5) + 
  scale_y_continuous(limits = c(0,1))