Vẽ khoảng tin cậy cho xác suất dự đoán từ hồi quy logistic

Ok, tôi có một hồi quy logistic và đã sử dụng predict()hàm để phát triển đường cong xác suất dựa trên ước tính của tôi.

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

Điều này thật tuyệt nhưng tôi tò mò về việc vẽ các khoảng tin cậy cho xác suất. Tôi đã thử plot.ci()nhưng không có may mắn. Bất cứ ai có thể chỉ cho tôi một số cách để thực hiện điều này, tốt nhất là với cargói hoặc cơ sở R.

Mã bạn đã sử dụng ước tính mô hình hồi quy logistic bằng glmhàm. Bạn đã không bao gồm dữ liệu, vì vậy tôi sẽ chỉ tạo một số.

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

Một mô hình hồi quy logistic mô hình mối quan hệ giữa một biến phản ứng nhị phân và, trong trường hợp này, một yếu tố dự đoán liên tục. Kết quả là xác suất chuyển đổi logit như một mối quan hệ tuyến tính với yếu tố dự đoán. Trong trường hợp của bạn, kết quả là một phản ứng nhị phân tương ứng với chiến thắng hoặc không chiến thắng khi đánh bạc và nó được dự đoán bởi giá trị của cược. Các hệ số từ mod1được đưa ra trong tỷ lệ cược được ghi lại (rất khó để giải thích), theo:

Để chuyển đổi tỷ lệ cược đã đăng nhập thành xác suất, chúng tôi có thể dịch phần trên sang

Bạn có thể sử dụng thông tin này để thiết lập cốt truyện. Đầu tiên, bạn cần một phạm vi của biến dự đoán:

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

Sau đó, bằng cách sử dụng predict, bạn có thể có được dự đoán dựa trên mô hình của mình

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

Lưu ý rằng các giá trị được trang bị cũng có thể được lấy thông qua

mod1$fitted

Bằng cách chỉ định se.fit=TRUE, bạn cũng nhận được lỗi tiêu chuẩn liên quan đến từng giá trị được trang bị. Kết quả data.framelà một ma trận với các thành phần sau: dự đoán được trang bị ( fit), sai số chuẩn ước tính ( se.fit) và vô hướng cho căn bậc hai của độ phân tán được sử dụng để tính toán các lỗi tiêu chuẩn ( residual.scale). Trong trường hợp logit nhị thức, giá trị sẽ là 1 (mà bạn có thể thấy bằng cách nhập preddat$residual.scalevào R). Nếu bạn muốn xem một ví dụ về những gì bạn đã tính toán cho đến nay, bạn có thể nhập head(data.frame(preddat)).

Bước tiếp theo là thiết lập cốt truyện. Tôi muốn thiết lập một khu vực vẽ trống với các tham số trước:

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

Bây giờ bạn có thể thấy nơi quan trọng để biết cách tính xác suất được trang bị. Bạn có thể vẽ đường tương ứng với xác suất được trang bị theo công thức thứ hai ở trên. Sử dụng preddat data.framebạn có thể chuyển đổi các giá trị được trang bị thành xác suất và sử dụng giá trị đó để vẽ một đường thẳng dựa trên các giá trị của biến dự đoán của bạn.

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

Cuối cùng, trả lời câu hỏi của bạn, khoảng tin cậy có thể được thêm vào biểu đồ bằng cách tính xác suất cho các giá trị được trang bị nhân +/- 1.96với lỗi tiêu chuẩn:

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

Biểu đồ kết quả (từ dữ liệu được tạo ngẫu nhiên) sẽ trông giống như thế này:

Vì lợi ích của sự nhanh chóng, đây là tất cả các mã trong một đoạn:

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

(Lưu ý: Đây là một câu trả lời được chỉnh sửa rất nhiều trong nỗ lực làm cho nó phù hợp hơn với stats.stackexchange.)

Đây là một sửa đổi của giải pháp @ smillig. Tôi sử dụng các công cụ tidyverse ở đây, và cũng sử dụnglinkinv chức năng là một phần của đối tượng mô hình GLM mod1. Bằng cách đó, bạn không phải đảo ngược chức năng logistic theo cách thủ công và phương pháp này sẽ hoạt động bất kể GLM cụ thể nào bạn phù hợp.

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