r语言 - 绘制加权有序逻辑回归的预测概率

Question

我正在为 R 中的类复制一篇文章，需要一些帮助将我的预测概率转换为他们制作的图。 为本文图 1 的第一个图。

本文的数据可以在这里找到。

注意：我建议使用 .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)

我最终得到了这些回归系数。

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

感谢您的帮助

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

Answer 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()

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