相互作用边际效应使用ggplot2绘制覆盖直方图

Question

我想创建一个交互边际效应图，其中预测变量的直方图位于图的背景中。 这个问题有点复杂，因为边际效应图也很明显。 我希望最终结果看起来像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值。

Answer 1

查看这篇文章： https ： //rpubs.com/kohske/dual_axis_in_ggplot2

我按照步骤操作，得到了以下情节：

另外，请注意我添加了scale_y_continuous(expand = c(0,0))以使直方图从x轴开始。

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)