Построение доверительных интервалов для прогнозируемых вероятностей из логистической регрессии

Хорошо, у меня есть логистическая регрессия, и я использовал 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))