绘制加权序数Logistic回归的预测概率

时间:2019-12-17 20:36:52

标签: r ggplot2 plot logistic-regression

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

可以在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

我该如何绘制预测的概率并用预测的概率和置信区间作图?

感谢您的帮助

注意:经过编辑使其可用于其他研究人员

2 个答案:

答案 0 :(得分:0)

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


答案 1 :(得分:0)

这非常接近,从您的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()