R 使用ggplot2使用叠加直方图绘制交互边缘效果图

我想创建一个交互边际效应图，其中预测值的直方图位于该图的背景中。这个问题有点复杂，因为边际效应图也是分面的。我希望最终的结果看起来像是MARHIS软件包在Stata所做的事情。对于连续预测，我只使用

geom_rug

，但这不适用于因子。我想使用

geom_直方图

，但我遇到了缩放问题：

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()

它起作用并生成此图表：

但是，当我添加直方图位时

+   geom_histogram(aes(cenretrosoc), position="identity", linetype=1,
                   fill="gray60", data = data, alpha=0.5) 

情况就是这样：

我认为这是因为预测概率和直方图在Y轴上的比例不同。但我不知道如何解决这个问题。有什么想法吗

更新：

这里有一个可复制的示例来说明这个问题（它需要WWGbook包来获取所使用的数据）

它确实会添加直方图，但会用直方图值覆盖OY比例。在这个例子中，人们仍然可以看到效果，因为最初的预测概率尺度与频率相当。然而，在我的例子中，一个有很多值的数据集，情况并非如此

最好我不会有任何规模的直方图显示。它应该有一个最大值，即预测的概率标度最大值，因此它覆盖相同的区域，但不会覆盖纵轴上的pred prob值。

查看此帖子：

我按照步骤进行操作，得到了以下曲线图：

另外，请注意，我添加了

scale\u y\u 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)

m1查看此帖子：

我按照步骤进行操作，得到了以下曲线图：


另外，请注意，我添加了
scale\u y\u 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)

m1请添加一个数据集，以便于帮助您。如果是规模问题，您可以对数据进行规范化，使其介于0和1之间。请添加数据集，以便于帮助您。如果是规模问题，您可以规范化数据，使其介于0和1之间。对不起，我的错误，这是内存中对象的问题（尽管我无法删除注释）。我在很大程度上对绘图进行了自定义，因此这是最终结果：[我还有一个问题，我想问你。X轴线出现了一些奇怪的情况。你有什么建议来纠正图案变化，只留下实线吗？谢谢你的帮助！histogram@Endre我无法在不查看数据的情况下真正找出问题的原因。这些是虚线吗当您尝试单独绘制轴上的线时，轴上的线会出现？抱歉，我的错误，这是内存中的对象的问题（尽管我无法删除我的注释）。我在很大程度上自定义了绘图，因此这是最终结果：[我还有一个问题，我想问你。X轴线出现了一些奇怪的情况。你有什么建议来纠正图案变化，只留下实线吗？谢谢你的帮助！histogram@Endre我无法在不查看数据的情况下真正找出问题的原因。这些是虚线吗当您尝试单独绘制轴上的线时，是否显示这些线？
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)