ロジスティック回帰からの予測確率の信頼区間のプロット

ロジスティック回帰があり、この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"))

ロジスティック回帰モデルは、バイナリ応答変数と、この場合は1つの連続予測子との関係をモデル化します。結果は、予測変数に対する線形関係としてのロジット変換確率です。あなたの場合、結果はギャンブルでの勝ちまたは不勝に対応するバイナリ応答であり、賭け金の価値によって予測されています。からの係数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"))

これで、適合確率の計算方法を知ることが重要な場所を確認できます。上記の2番目の式に従って、近似確率に対応する線を引くことができます。を使用して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))

ランダムに生成されたデータから得られるプロットは、次のようになります。

便宜上、ここにすべてのコードを1つのチャンクで示します。

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のソリューションの変更点を次に示します。ここでは整頓されたツールを使用し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))