Tracciare intervalli di confidenza per le probabilità previste da una regressione logistica

Ok, ho una regressione logistica e ho usato la predict()funzione per sviluppare una curva di probabilità basata sulle mie stime.

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

Questo è fantastico, ma sono curioso di tracciare gli intervalli di confidenza per le probabilità. Ci ho provato plot.ci()ma non ho avuto fortuna. Qualcuno può indicarmi alcuni modi per farlo, preferibilmente con il carpacchetto o la base R.

Il codice utilizzato stima un modello di regressione logistica utilizzando la glmfunzione. Non hai incluso i dati, quindi ne trarrò un po '.

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

Un modello di regressione logistica modella la relazione tra una variabile di risposta binaria e, in questo caso, un predittore continuo. Il risultato è una probabilità trasformata in logit come relazione lineare con il predittore. Nel tuo caso, il risultato è una risposta binaria corrispondente alla vincita o non vincente al gioco d'azzardo e viene predetto dal valore della scommessa. I coefficienti di mod1sono indicati in quote registrate (che sono difficili da interpretare), secondo:

Per convertire le probabilità registrate in probabilità, possiamo tradurre quanto sopra

È possibile utilizzare queste informazioni per impostare la trama. Innanzitutto, è necessario un intervallo della variabile predittore:

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

Quindi utilizzando predict, è possibile ottenere previsioni basate sul modello

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

Si noti che i valori adattati possono anche essere ottenuti tramite

mod1$fitted

Specificando se.fit=TRUE, si ottiene anche l'errore standard associato a ciascun valore adattato. Il risultato data.frameè una matrice con i seguenti componenti: le previsioni adattate ( fit), gli errori standard stimati ( se.fit) e uno scalare che fornisce la radice quadrata della dispersione utilizzata per calcolare gli errori standard ( residual.scale). Nel caso di un logit binomiale, il valore sarà 1 (che si vede entrando preddat$residual.scalein R). Se vuoi vedere un esempio di ciò che hai calcolato finora, puoi digitare head(data.frame(preddat)).

Il prossimo passo è impostare la trama. Mi piace impostare prima un'area di disegno vuota con i parametri:

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

Ora puoi vedere dove è importante sapere come calcolare le probabilità adattate. Puoi disegnare la linea corrispondente alle probabilità montate seguendo la seconda formula sopra. Usando ilpreddat data.frame è possibile convertire i valori adattati in probabilità e usarlo per tracciare una linea rispetto ai valori della variabile del predittore.

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

Infine, rispondi alla tua domanda, gli intervalli di confidenza possono essere aggiunti al grafico calcolando la probabilità per i valori adattati per +/- 1.96l'errore standard:

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

Il diagramma risultante (dai dati generati casualmente) dovrebbe assomigliare a questo:

Per convenienza, ecco tutto il codice in un unico pezzo:

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

(Nota: questa è una risposta fortemente modificata nel tentativo di renderla più rilevante per stats.stackexchange.)

Ecco una modifica della soluzione di @ smillig. Uso qui gli strumenti tidyverse e utilizzo anche la linkinvfunzione che fa parte dell'oggetto modello GLM mod1. In questo modo, non è necessario invertire manualmente la funzione logistica e questo approccio funzionerà indipendentemente dal GLM specifico che si adatta.

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