具有第一差異的系數圖

Question

我在r中運行邏輯模型。 我試圖用系數圖表示我自變量的概率差異。 具體來說，我想通過將感興趣的變量從其最小值移至最大值（同時使其他變量保持其均值或眾數）來創建概率差異。

在所附圖片中，我希望圖形看起來與上半部分相似。

我已經運行了這段代碼：

 mydata <- read.csv("http://www.ats.ucla.edu/stat/data/binary.csv")
 mylogit <- glm(admit ~ gre + gpa + rank, data = mydata, family =
 "binomial")

然后，我計算出每個變量的最小值和最大值的預測概率，然后將二者相減。 我對間隔的上限和下限重復了此過程。 附上我的代碼

plotdat <- data.frame(gre=c(.220, 800), gpa=mean(mydata$gpa, na.rm=TRUE), rank=c(2) ) 
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

Grebeta<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
Gremin<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))-exp(preddat$fit[1]+1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1]))
Gremax<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))-exp(preddat$fit[1]-1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))


plotdat <- data.frame(gpa=c(2.26, 4), gre=mean(mydata$gre, na.rm=TRUE), rank=c(2) )
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

GPAbeta<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
GPAmin<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))-exp(preddat$fit[1]+1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1]))
GPAmax<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))-exp(preddat$fit[1]-1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))


plotdat <- data.frame(rank=c(4, 1), gre=mean(mydata$gre, na.rm=TRUE), gpa=mean(mydata$gpa, na.rm=TRUE ))
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

Rankbeta<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
Rankmin<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))-exp(preddat$fit[1]+1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1]))
Rankmax<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))-exp(preddat$fit[1]-1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))

之后，我創建了三個包含概率和譜帶差異的向量。 附上我的代碼：

se.max<- c(Gremax   , GPAmax  , Rankmax  )
coef.vec<- c( Grebeta  ,GPAbeta  , Rankbeta ) 
se.min<-c(Gremin , GPAmin, Rankmin)



var.names <- c("gre", "gpa", "rank")

最后，我繪制了圖表。

y.axis <- c(length(coef.vec):1)

par(mar=c(2, 13, 0, 0))

plot(coef.vec, y.axis, type = "p", axes = F, xlab = "", ylab = "", pch = 19, cex = 1.2,  xlim = c(-2,2.5), xaxs = "r", main = "")

segments(se.max, y.axis,se.min, y.axis, lwd =  1.5)

axis(1, at = seq(-1,1,by=.25), labels = NA, tick = T,cex.axis = 1.2, mgp = c(2,.7,0))
axis(1, at = seq(-1,1,by=.5), labels =  c(-1,  -.5,  0, .5,1), tick = T,cex.axis = 1.2, mgp = c(2,.7,0))

axis(2, at = y.axis, label = var.names, las = 1, tick = T, ,mgp = c(2,.6,0), cex.axis = 1.2)
segments(0,0,0,17,lty=2)

但是，我無法繪制出置信區間。 以下是我的最終輸出。

看來我的信任范圍不會策划。 如果有人可以提供幫助並指出我的計算或代碼中的錯誤，我將不勝感激。

Answer 1

plotdat <- data.frame(gre=c(.220, 800), gpa=mean(mydata$gpa, na.rm=TRUE), rank=c(2) ) 
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

#GRE High
GREbetahigh<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))
GREminhigh<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))
GREmaxhigh<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))


#GRE low
GREbetalow<-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
GREminlow<-(exp(preddat$fit[1]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1])))
GREmaxlow<-exp(preddat$fit[1]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))

#GRE Diff
GREbeta.diff<-GREbetahigh-GREbetalow
GREmax.diff<-GREmaxhigh-GREmaxlow
GREmin.diff<-GREminhigh-GREminlow

#GPA
plotdat <- data.frame(gpa=c(2.26, 4), gre=mean(mydata$gre, na.rm=TRUE), rank=c(2) )
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

#GPA high
GPAbetahigh<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))
GPAminhigh<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))
GPAmaxhigh<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))

#GPA low
GPAbetalow<-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
GPAminlow<-(exp(preddat$fit[1]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1])))
GPAmaxlow<-exp(preddat$fit[1]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))

#GPA Diff
GPAbeta.diff<-GPAbetahigh-GPAbetalow
GPAmax.diff<-GPAmaxhigh-GPAmaxlow
GPAmin.diff<-GPAminhigh-GPAminlow

#Rank

plotdat <- data.frame(rank=c(4, 1), gre=mean(mydata$gre, na.rm=TRUE), gpa=mean(mydata$gpa, na.rm=TRUE ))
preddat <- predict(mylogit, newdata=plotdat, se.fit=TRUE)

#Rank high
Rankbetahigh<-(exp(preddat$fit[2])/(1+exp(preddat$fit[2])))
Rankminhigh<-(exp(preddat$fit[2]+1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]+1.96*preddat$se.fit[2])))
Rankmaxhigh<-exp(preddat$fit[2]-1.96*preddat$se.fit[2])/(1+exp(preddat$fit[2]-1.96*preddat$se.fit[2]))

#Rank Low
Rankbetalow<-(exp(preddat$fit[1])/(1+exp(preddat$fit[1])))
Rankminlow<-(exp(preddat$fit[1]+1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]+1.96*preddat$se.fit[1])))
Rankmaxlow<-exp(preddat$fit[1]-1.96*preddat$se.fit[1])/(1+exp(preddat$fit[1]-1.96*preddat$se.fit[1]))


#Rank Diff
Rankbeta.diff<-Rankbetahigh-Rankbetalow
Rankmax.diff<-Rankmaxhigh-Rankmaxlow
Rankmin.diff<-Rankminhigh-Rankminlow

#Graph
se.max<- c(GREmax.diff   , GPAmax.diff, Rankmax.diff)
coef.vec<- c( GREbeta.diff , GPAbeta.diff, Rankbeta.diff)
se.min<-c(GREmin.diff , GPAmin.diff, Rankmin.diff)

var.names <- c("gre", "gpa", "rank")

y.axis <- c(length(coef.vec):1)

par(mar=c(2, 13, 0, 0))


plot(y.axis, coef.vec, type = "p", axes = F, xlab = "", ylab = "", pch = 19, cex = 1.2,  ylim = c(-1,1), xlim=c(1,3.3), xaxs = "r", main = "")
segments(y.axis, se.max,y.axis, se.min, lwd =  1.5)

axis(2, at = seq(-1,1,by=.25), labels = NA, tick = T,cex.axis = 1.2, mgp = c(2,.7,0))
axis(2, at = seq(-1,1,by=.5), labels =  c(-1,  -.5,  0, .5, 1), tick = T,cex.axis = 1.2, mgp = c(2,.7,0))

axis(1, at = y.axis, label = var.names, las = 1, tick = T, ,mgp = c(2,.6,0), cex.axis = 1.2)
segments(1,0,3.3,0,lty=2)