相互作用邊際效應使用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)