使用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

我認爲這是因爲預測概率和他的預測概率不同togram在Y軸上。但我不知道如何解決這個問題。有任何想法嗎？

UPDATE：

這裏有一個重複的例子來說明這個問題（它需要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概率值。

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)