Perché l'intervallo credibile bayesiano in questa regressione polinomiale è distorto mentre l'intervallo di confidenza è corretto?

Considera la trama sotto in cui ho simulato i dati come segue. Osserviamo un risultato binario per il quale la vera probabilità di essere 1 è indicata dalla linea nera. La relazione funzionale tra covariata e è 3 ° polinomio di ordine con il collegamento logistico (in modo che non è lineare in un doppio senso). x p ( y o b s = 1 | x $y_{obs}$$x$$p(y_{obs}=1 | x)$

La linea verde è la regressione logistica GLM in cui viene introdotto come polinomio di terzo ordine. Le linee verdi tratteggiate sono gli intervalli di confidenza del 95% attorno alla previsione , dove i coefficienti di regressione adattati. Ho usato e per questo.p ( y o b s = 1 | x , β ) $x$$p(y_{obs}=1 | x, \hat{\beta})$$\hat{\beta}$R glmpredict.glm

Allo stesso modo, la linea della prupla è la media del posteriore con intervallo credibile del 95% per di un modello di regressione logistica bayesiana usando un precedente uniforme. Ho usato il pacchetto con la funzione per questo (l'impostazione dà l'uniforme non informativa precedente).$p(y_{obs}=1 | x, \beta)$MCMCpackMCMClogitB0=0

I punti rossi indicano osservazioni nel set di dati per cui , i punti neri sono osservazioni con . Si noti che come comune nella classificazione / analisi discreta si osserva ma non .y o b s = 0 y p ( y o b s = 1 | x $y_{obs}=1$$y_{obs}=0$$y$$p(y_{obs}=1 | x)$

Si possono vedere diverse cose:

1. Ho simulato apposta che è scarso sulla mano sinistra. Voglio che la fiducia e l'intervallo credibile si allarghino qui a causa della mancanza di informazioni (osservazioni).$x$
2. Entrambe le previsioni sono distorte verso l'alto a sinistra. Questo pregiudizio è causato dai quattro punti rossi che indicano osservazioni, il che suggerisce erroneamente che la vera forma funzionale andrebbe qui. L'algoritmo ha informazioni insufficienti per concludere che la vera forma funzionale è piegata verso il basso.$y_{obs}=1$
3. L'intervallo di confidenza si allarga come previsto, mentre l'intervallo credibile no . In effetti l'intervallo di confidenza racchiude lo spazio completo dei parametri, come dovrebbe a causa della mancanza di informazioni.

Sembra che l'intervallo credibile sia sbagliato / troppo ottimistico qui per una parte di . È davvero indesiderabile che l'intervallo credibile si restringa quando l'informazione diventa scarsa o è completamente assente. Di solito non è così che reagisce un intervallo credibile. Qualcuno può spiegare:$x$

1. Quali sono le ragioni per questo?
2. Quali passi posso prendere per ottenere un intervallo credibile migliore? (cioè uno che racchiude almeno la vera forma funzionale, o meglio diventa ampio quanto l'intervallo di confidenza)

Il codice per ottenere intervalli di predizione nel grafico è stampato qui:

fit <- glm(y_obs ~ x + I(x^2) + I(x^3), data=data, family=binomial)
x_pred <- seq(0, 1, by=0.01)
pred <- predict(fit, newdata = data.frame(x=x_pred), se.fit = T)
plot(plogis(pred$fit), type='l')
matlines(plogis(pred$fit + pred$se.fit %o% c(-1.96,1.96)), type='l', col='black', lty=2)


library(MCMCpack)
mcmcfit <- MCMClogit(y_obs ~ x + I(x^2) + I(x^3), data=data, family=binomial)
gibbs_samps <- as.mcmc(mcmcfit)
x_pred_dm <- model.matrix(~ x + I(x^2) + I(x^3), data=data.frame('x'=x_pred))
gibbs_preds <- apply(gibbs_samps, 1, `%*%`, t(x_pred_dm))
gibbs_pis <- plogis(apply(gibbs_preds, 1, quantile, c(0.025, 0.975)))
matlines(t(gibbs_pis), col='red', lty=2)

Accesso ai dati : https://pastebin.com/1H2iXiew grazie a @DeltaIV e @AdamO

Per un modello frequentista, la varianza dei ingrandisce previsione proporzionale al quadrato della distanza dal baricentro di . Il metodo utilizzato per calcolare gli intervalli di previsione per un GLM bayesiano utilizza quantili empirici basati sulla curva di probabilità adattata, ma non tiene conto della leva di$X$$X$

Un GLM frequentista binomiale non è diverso da un GLM con collegamento di identità, tranne per il fatto che la varianza è proporzionale alla media.

Si noti che qualsiasi rappresentazione polinomiale delle probabilità di logit porta a previsioni di rischio che convergono in 0 come e 1 come o viceversa, a seconda del segno del termine dell'ordine polinomiale più alto .X → $X\rightarrow -\infty$$X\rightarrow \infty$

Per la previsione del frequentista, l'aumento proporzionale della deviazione al quadrato (leva) nella variazione delle previsioni domina questa tendenza. Questo è il motivo per cui il tasso di convergenza agli intervalli di previsione approssimativamente uguale a [0, 1] è più veloce della convergenza logitica polinomiale del terzo ordine con probabilità di 0 o 1 singolarmente.

Questo non è così per i quantili posteriori bayesiani. Non vi è alcun uso esplicito della deviazione al quadrato, quindi ci basiamo semplicemente sulla proporzione di tendenze dominanti 0 o 1 per costruire intervalli di previsione a lungo termine.

Ciò è reso evidente estrapolando molto lontano negli estremi di .$X$

Usando il codice che ho fornito sopra otteniamo:

> x_pred_dom <- model.matrix(~ x + I(x^2) + I(x^3), data=data.frame('x'=c(1000)))
> gibbs_preds <- plogis(apply(gibbs_samps[1000:10000, ], 1, `%*%`, t(x_pred_dom))) # a bunch of 0/1s basically past machine precision
> prop.table(table(gibbs_preds))
gibbs_preds
         0          1 
0.97733585 0.02266415 
> 

Quindi il 97,75% delle volte, il terzo termine polinomiale era negativo. Ciò è verificabile dai campioni di Gibbs:

> prop.table(table(gibbs_samps[, 4]< 0))

 FALSE   TRUE 
0.0225 0.9775 

Quindi la probabilità prevista converge a 0 quando va all'infinito. Se ispezioniamo le SE del modello bayesiano, troviamo che la stima del terzo termine polinomiale è -185,25 con se 108,81 che significa che sono 1,70 SD da 0, quindi usando le normali leggi di probabilità, dovrebbe scendere sotto lo 0 95,5% delle volte ( non una previsione terribilmente diversa basata su 10.000 iterazioni). Solo un altro modo di comprendere questo fenomeno.$X$

D'altro canto, l'addetto al frequentista aumenta fino a 0,1 come previsto:

freq <- predict(fit, newdata = data.frame(x=1000), se.fit=T)
plogis(freq$fit + c(-1.96, 1.96) %o% freq$se.fit)

dà:

> plogis(freq$fit + c(-1.96, 1.96) %o% freq$se.fit)
     [,1]
[1,]    0
[2,]    1