信頼区間が正しいのに、なぜこの多項式回帰ではベイジアンの信頼できる区間が偏っているのですか？

以下のようにデータをシミュレーションした下のプロットを考えてみます。1になる真の確率が黒い線で示されているバイナリの結果を調べます。共変量xとp （y o b s = 1 | x ）の間の関数関係は、ロジスティックリンクを持つ3次多項式です（したがって、双方向で非線形です）。$y_{obs}$$x$$p(y_{obs}=1 | x)$

緑の線はGLMロジスティック回帰近似で、は3次多項式として導入されています。破線の緑の線は、予測の周りの95％信頼区間であるP （Y O B S = 1 | X 、β）ここで、βフィット回帰係数。私はこれを使用しました。$x$$p(y_{obs}=1 | x, \hat{\beta})$$\hat{\beta}$R glmpredict.glm

同様に、プルプルラインは、均一な事前分布を使用したベイジアンロジスティック回帰モデルのについて95％信頼できる区間をもつ事後の平均です。私はこのために機能付きのパッケージを使用しました（設定により、事前に情報のない均一な情報が提供されます）。$p(y_{obs}=1 | x, \beta)$MCMCpackMCMClogitB0=0

赤い点は、のデータセット内の観測を示し、黒い点はy o b s = 0 の観測です。分類/離散分析では一般的ですが、pではなくy （y o b s = 1 | x ）が観察されることに注意してください。$y_{obs}=1$$y_{obs}=0$$y$$p(y_{obs}=1 | x)$

いくつかのことがわかります。

1. 左側でがスパースであることを意図的にシミュレーションしました。情報（観察）が不足しているため、ここでは信頼と信頼できる間隔を広くしてほしい。$x$
2. $y_{obs}=1$
3. 信頼区間は期待どおりに広くなりますが、信頼区間はそうではありません。実際、信頼区間は完全なパラメータ空間を囲みます。情報が不足しているためです。

$x$

1. これの理由は何ですか？
2. より良い信頼できる間隔に到達するためにどのようなステップを踏めますか？（つまり、少なくとも真の関数形を囲むもの、またはより良いものは信頼区間と同じくらい広くなります）

グラフィックで予測区間を取得するためのコードを次に示します。

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)

データ アクセス：https : //pastebin.com/1H2iXiew感謝@DeltaIVおよび@AdamO

$X$$X$

二項頻出GLMは、分散が平均に比例することを除いて、アイデンティティリンクを持つGLMと同じです。

$X\rightarrow -\infty$$X\rightarrow \infty$

頻度論的予測の場合、予測の分散の二乗偏差（レバレッジ）の比例増加がこの傾向を支配します。これが、[0、1]にほぼ等しい予測区間への収束率が、0または1の確率への3次多項式ロジット収束よりも速くなる理由です。

これは、ベイジアン事後近似分位数には当てはまりません。二乗偏差の明示的な使用はないため、長期予測間隔を構築するために、0または1傾向を支配する割合に単純に依存します。

$X$

上記で提供したコードを使用すると、次のようになります。

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

したがって、97.75％の時間、3番目の多項式の項は負でした。これは、ギブスのサンプルから確認できます。

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

 FALSE   TRUE 
0.0225 0.9775 

$X$

一方、頻出フィットは予想どおり0,1に達します。

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

与える：

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