我想创建一个交互边际效应图,其中预测变量的直方图位于图的背景中。这个问题有点复杂,因为边际效应图也很明显。我希望最终结果看起来像MARHIS包在Stata中做的事情。在连续预测变量的情况下,我只使用geom_rug
,但这不适用于因素。我想使用geom_histogram
但我遇到了扩展问题:
ggplot(newdat, aes(cenretrosoc, linetype = factor(wave))) +
geom_line(aes(y = cengovrec), size=0.8) +
scale_linetype_manual(values = c("dotted", "twodash", "solid")) +
geom_line(aes(y = plo,
group=factor(wave)), linetype =3) +
geom_line(aes(y = phi,
group=factor(wave)), linetype =3) +
facet_grid(. ~ regioname) +
xlab("Economy") +
ylab("Disapproval of Record") +
labs(linetype='Wave') +
theme_minimal()
有效,并生成此图表:1
然而,当我添加直方图位
时+ geom_histogram(aes(cenretrosoc), position="identity", linetype=1,
fill="gray60", data = data, alpha=0.5)
这是发生的事情:2
我认为这是因为预测概率和直方图在Y轴上的尺度不同。但我不知道如何解决这个问题。有什么想法吗?
更新
这是一个可重现的例子来说明问题(它需要WWGbook包用于它使用的数据)
# install.packages("WWGbook")
# install.packages("lme4")
# install.packages("ggplot2")
require("WWGbook")
require("lme4")
require("ggplot2")
# checking the dataset
head(classroom)
# specifying the model
model <- lmer(mathgain ~ yearstea*sex*minority
+ (1|schoolid/classid), data=classroom)
# dataset for prediction
newdat <- expand.grid(
mathgain = 0,
yearstea = seq(min(classroom$yearstea, rm=TRUE),
max(classroom$yearstea, rm=TRUE),
5),
minority = seq(0, 1, 1),
sex = seq(0,1,1))
mm <- model.matrix(terms(model), newdat)
## calculating the predictions
newdat$mathgain <- predict(model,
newdat, re.form = NA)
pvar1 <- diag(mm %*% tcrossprod(vcov(model), mm))
## Calculating lower and upper CI
cmult <- 1.96
newdat <- data.frame(
newdat, plo = newdat$mathgain - cmult*sqrt(pvar1),
phi = newdat$mathgain + cmult*sqrt(pvar1))
## this is the plot of fixed effects uncertainty
marginaleffect <- ggplot(newdat, aes(yearstea, linetype = factor(sex))) +
geom_line(aes(y = mathgain), size=0.8) +
scale_linetype_manual(values = c("dotted", "twodash")) +
geom_line(aes(y = plo,
group=factor(sex)), linetype =3) +
geom_line(aes(y = phi,
group=factor(sex)), linetype =3) +
facet_grid(. ~ minority) +
xlab("First grade teacher years of teaching experience") +
ylab("Predicted Probability of student gain in math") +
labs(linetype='Sex') +
theme_minimal()
正如可以看到marginaleffect
是边际效应的图:)现在我想将直方图添加到背景中,所以我写道:
marginaleffect + geom_histogram(aes(yearstea), position="identity", linetype=1,
fill="gray60", data = classroom, alpha=0.5)
它确实添加了直方图,但它用直方图值覆盖了OY标度。在这个例子中,人们仍然可以看到效果,因为原始预测概率量表与频率相当。但是,在我的情况下,具有许多值的数据集,情况并非如此。
优选地,我没有所示直方图的任何比例。它应该只有一个最大值,即预测的概率标度最大值,因此它覆盖相同的区域,但它不会覆盖垂直轴上的pred prob值。
答案 0 :(得分:0)
Check this post out: https://rpubs.com/kohske/dual_axis_in_ggplot2
I followed the steps and was able to get the following plot:
Also, note that I've added scale_y_continuous(expand = c(0,0))
to make histograms start from the x-axis.
m1 <- marginaleffect + geom_line(aes(y = mathgain), size=0.8) +
scale_linetype_manual(values = c("dotted", "twodash")) +
geom_line(aes(y = plo,
group=factor(sex)), linetype =3) +
geom_line(aes(y = phi,
group=factor(sex)), linetype =3)
m2 <- marginaleffect + geom_histogram(aes(yearstea), position="identity", linetype=1,
fill="gray60", data = classroom, alpha=0.5, bins = 30) +
scale_y_continuous(expand = c(0,0))
g1 <- ggplot_gtable(ggplot_build(m1))
g2 <- ggplot_gtable(ggplot_build(m2))
library(gtable)
pp <- c(subset(g1$layout, name == "panel", se = t:r))
# The link uses g2$grobs[[...]] but it doesn't seem to work... single bracket works, on the other hand....
g <- gtable_add_grob(g1, g2$grobs[which(g2$layout$name == "panel")], pp$t, pp$l, pp$b, pp$l)
library(grid)
grid.draw(g)