Складання інтервалів довіри для прогнозованих ймовірностей з логістичної регресії

Гаразд, я маю логістичну регресію і використовував 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))