绘制加权有序 Logistic 回归的预测概率答案

【问题标题】：Plotting Predicted Probabilities of Weighted Ordinal Logistic Regression绘制加权有序 Logistic 回归的预测概率
【发布时间】：2019-12-17 20:36:52
【问题描述】：

我正在为 R 中的一个类复制一篇文章，需要一些帮助将我的预测概率转换为 plot they made.this article 的图 1 的第一个图。

文章的数据可以在here找到。

注意：我建议使用 .tab 而不是 .rdata。 .rdata 使完成这些分析变得困难。如果您遇到此问题，请在此处给我发消息，我会将完整代码发送给您。

我首先完成了我的加权有序逻辑回归

library(MASS) # Weighted Ordinal Logistic Regression
ordlogit1<-polr(affectpol_o ~ empconc + empdist +emppers +empfant +pidext +ideoext +news +dem +educ +age +male +white +inc3miss_c, data=table1, method=c("logistic"), Hess=T, weights=table1$weight_group)

我最终得到了这些regression coefficients。

如何绘制预测概率并使用预测概率和置信区间绘制图？

感谢您的帮助

注意：经过编辑使其可供其他研究人员使用

【问题讨论】：

我现在已经取得了一些进展，但仍然对如何围绕这条线建立置信区间感到有点困惑。这里的第二个答案假设我仍在使用那个预测概率表，我不再使用它了。我正在使用答案 1 中的代码。

标签： r ggplot2 plot logistic-regression

【解决方案1】：

这非常接近，从您的 prob 表开始：

library(tibble)
library(tidyr)
library(ggplot2)
prob %>% rownames_to_column() %>% 
  pivot_longer(-rowname) %>% 
  ggplot(aes(as.integer(rowname), value, group=name, linetype=name)) +
  geom_line() +
  scale_linetype_manual(values=c(`2.5%`=2, `97.5%`=2, mean=1),
    guide='none') +
  labs(x='Empathic concern', y='',
       title='Relative Inparty Favoritism',
       subtitle='Pr(etc)') +
  theme_minimal()

【讨论】：

这不是我要找的，请参阅我的帖子以获得正确的解决方案。感谢您的帮助！

【解决方案2】：

library(glm.predict)
library(VGAM)
for (i in 1:length(seq(from=0, to=1, by=.01)))
  {
  newdata3 <- data.frame(empconc=seq(from=0, to=1, by=.01)[i] ,
                         empdist= mean(table1$empdist,na.rm=TRUE),
                         emppers=mean(table1$emppers,na.rm=TRUE),
                         empfant=mean(table1$empfant,na.rm=TRUE),
                         pidext=mean(table1$pidext,na.rm=TRUE),
                         ideoext=mean(table1$ideoext,na.rm=TRUE),
                         news=mean(table1$news,na.rm=TRUE),
                         dem=1, 
                         educ=mean(table1$educ,na.rm=TRUE), 
                         age=mean(table1$age,na.rm=TRUE), 
                         male=0,
                         white=1,
                         inc3miss_c2=0,
                         inc3miss_c3=0,
                         inc3miss_c4=0)
 newdata3<-as.matrix(newdata3)
   if(i==1){
    prob<-data.frame(basepredict(ordlogit1,newdata3),
                     -6:6)
    prob<-data.frame(prob,seq(from=0, to=1, by=.01)[i])
  }else{
    temp<-data.frame(basepredict(ordlogit1,newdata3),
                     -6:6)
    temp<-data.frame(temp,seq(from=0, to=1, by=.01)[i])
    prob<-rbind(prob,temp)
  }
}

colnames(prob)<-c("mean","lower_bound","upper_bound","affectpol_o","empconc")

library(ggplot2)
ggplot(prob%>%filter(affectpol_o==6))+geom_line(aes(x=empconc,y=mean))+
  geom_ribbon(aes(x=empconc,ymin=lower_bound, ymax=upper_bound),alpha=0.2) +scale_y_continuous(limits=c(0,0.6))

【讨论】：