วางแผนช่วงความมั่นใจสำหรับความน่าจะเป็นที่คาดการณ์ไว้จากการถดถอยโลจิสติก


20

ตกลงฉันมีการถดถอยโลจิสติกและใช้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แพคเกจหรือฐานอาร์


4
(+1) เพื่อตอบสนองต่อการโหวตปิดหัวข้อ: เห็นได้ชัดว่าพื้นฐานสำหรับการลงคะแนนเหล่านั้นคือคำถามปรากฏขึ้นเพื่อถามคำถามที่เกี่ยวข้องกับซอฟต์แวร์อย่างหมดจด คำถามที่ควรปรากฏบนดังนั้น อย่างไรก็ตามหมายเหตุที่ฝังอยู่ในการตอบกลับปัจจุบันเป็นสูตรทางสถิติเพื่อสร้างจุดการพล็อต สิ่งนี้ชี้ให้เห็นว่ามีความสนใจทางสถิติของคำถามดังนั้นฉันลังเลที่จะลงคะแนนเพื่อการย้ายถิ่นฐาน คำตอบที่ดีที่นี่จะเน้นและอธิบายจุดทางสถิตินี้
whuber

คำตอบ:


26

รหัสที่คุณใช้ประมาณการแบบจำลองการถดถอยแบบลอจิสติกโดยใช้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"))

ตัวแบบการถดถอยแบบโลจิสติกส์จะจำลองความสัมพันธ์ระหว่างตัวแปรการตอบสนองแบบไบนารีและในกรณีนี้คือตัวทำนายแบบต่อเนื่องหนึ่งตัว ผลที่ได้คือความน่าจะเป็นแบบ logit-transformซึ่งเป็นความสัมพันธ์เชิงเส้นกับตัวทำนาย ในกรณีของคุณผลที่ได้คือการตอบสนองแบบไบนารีที่สอดคล้องกับการชนะหรือไม่ชนะการเดิมพันและจะถูกทำนายโดยมูลค่าของการเดิมพัน ค่าสัมประสิทธิ์จากmod1จะได้รับในอัตราต่อรองที่บันทึกไว้ (ซึ่งยากต่อการตีความ) ตาม:

logit(พี)=เข้าสู่ระบบ(พี(1-พี))=β0+β1x1

ในการแปลงอัตราต่อรองที่บันทึกไว้เป็นความน่าจะเป็นเราสามารถแปลด้านบนเป็น

พี=ประสบการณ์(β0+β1x1)(1+ประสบการณ์(β0+β1x1))

คุณสามารถใช้ข้อมูลนี้เพื่อตั้งค่าพล็อต ก่อนอื่นคุณต้องใช้ช่วงของตัวแปรทำนาย:

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) ในกรณีของ logit ทวินามที่ค่าจะเป็น 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 มากขึ้น)


ตัวแปรse.fitกำหนดไว้ที่ไหน?
มาโคร

ในpredict(..., se.fit=TRUE).
smillig

(-1) CIs เหล่านี้สำหรับแต่ละกรณี? ถ้าเป็นเช่นนั้นสำหรับผลลัพธ์แบบไบนารี CI ที่สมเหตุสมผลเพียงอย่างเดียวสำหรับความน่าจะเป็นที่คาดการณ์คือ [0,1] แม้ว่านี่อาจเป็นคำตอบที่มีความเชี่ยวชาญทางเทคนิค
rolando2

ตามความคิดเห็นของ @ whuber ฉันคิดว่าคำตอบที่ดีควรมีสูตรสำหรับการคำนวณ SE บางคนอาจแก้ไขและปรับปรุงคำตอบได้ไหม
ไฮเซนเบิร์ก

1
คำตอบของคุณดูเหมือนจะให้ 'ช่วงเวลาการทำนายค่าเฉลี่ย' เท่านั้น ฉันจะเพิ่ม 'ช่วงเวลาการทำนายจุด' ได้อย่างไร
Bob Hopez

0

นี่คือการแก้ไขโซลูชันของ @ 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))

3
แม้ว่าการใช้งานมักจะถูกผสมกับเนื้อหาสาระในคำถาม แต่เราควรจะเป็นเว็บไซต์สำหรับให้ข้อมูลเกี่ยวกับสถิติการเรียนรู้ของเครื่อง ฯลฯ ไม่ใช่รหัส มันอาจเป็นการดีที่จะให้รหัสเช่นกัน แต่โปรดอธิบายคำตอบที่สำคัญของคุณเป็นข้อความสำหรับผู้ที่ไม่ได้อ่านภาษานี้ดีพอที่จะรับรู้และแยกคำตอบจากรหัส
gung - Reinstate Monica
โดยการใช้ไซต์ของเรา หมายความว่าคุณได้อ่านและทำความเข้าใจนโยบายคุกกี้และนโยบายความเป็นส่วนตัวของเราแล้ว
Licensed under cc by-sa 3.0 with attribution required.