r - 如何在插值数据图的边缘上绘制原始数据的直方图

我想在同一图中显示每个预测变量的插值数据和原始数据的直方图。我曾在类似one的其他线程中看到过，人们解释了如何对散点图中显示的相同数据进行边际直方图，但是在这种情况下，直方图基于其他数据(原始数据)。

假设我们在钻石数据集中看到价格与克拉和表格之间的关系:

library(ggplot2)
p = ggplot(diamonds, aes(x = carat, y = table, color = price)) + geom_point()

我们可以添加一个边际频率图，例如与ggMarginal

library(ggExtra)
ggMarginal(p)

我们如何添加类似于预测钻石价格的图块？

library(mgcv)
model = gam(price ~ s(table, carat), data = diamonds)
newdat = expand.grid(seq(55,75, 5), c(1:4))
names(newdat) = c("table", "carat")
newdat$predicted_price = predict(model, newdat)

ggplot(newdat,aes(x = carat, y = table, fill = predicted_price)) +
    geom_tile()

理想情况下，直方图甚至会超出图块的边缘，因为这些数据点也会影响预测。但是，我会很高兴知道如何为tileplot中显示的范围绘制直方图。 (也许可以将超出范围的值添加到不同颜色的极值中。)

PS。我设法使用链接的thread中接受的答案的方法使直方图或多或少地与瓷砖图的边距对齐，但是前提是我删除了所有标签。如果可能的话，保留颜色图例特别好。

编辑:
eipi10提供了出色的解决方案。我试图对其稍加修改，以数字形式增加样本量，并以图形方式显示超出绘制范围的值，因为它们也会影响插值。
我打算在侧面的直方图中以其他颜色包含它们。我在此尝试将它们计入绘制范围的下限和上限。我还尝试在图中某处以数字绘制样本大小。但是，我都失败了。

这是我尝试以图形方式说明绘制区域之外的样本数量:

plot_data = diamonds
plot_data <- transform(plot_data, carat_range = ifelse(carat < 1 | carat > 4, "outside", "within"))
plot_data <- within(plot_data, carat[carat < 1] <- 1)
plot_data <- within(plot_data, carat[carat > 4] <- 4)
plot_data$carat_range = as.factor(plot_data$carat_range)

p2 = ggplot(plot_data, aes(carat, fill = carat_range)) +
    geom_histogram() +
    thm +
    coord_cartesian(xlim=xrng)

我尝试使用geom_text在数字中添加样本大小。我尝试将其安装在最右边的面板中，但很难(/对我来说是不可能)进行调整。我试图将其放在主图中(无论如何可能都不是最好的解决方案)，但它也不起作用(它删除了直方图和图例，位于右侧，并且未绘制所有geom_texts)。我还尝试添加第三行绘图并将其写入此处。我的尝试:

n_table_above = nrow(subset(diamonds, table > 75))
n_table_below = nrow(subset(diamonds, table < 55))
n_table_within = nrow(subset(diamonds, table >= 55 & table <= 75))

text_p = ggplot()+
    geom_text(aes(x = 0.9, y = 2, label = paste0("N(>75) = ", n_table_above)))+
    geom_text(aes(x = 1, y = 2, label = paste0("N = ", n_table_within)))+
    geom_text(aes(x = 1.1, y = 2, label = paste0("N(<55) = ", n_table_below)))+
    thm

library(egg)
pobj = ggarrange(p2, ggplot(), p1, p3,
                 ncol=2, widths=c(4,1), heights=c(1,4))

grid.arrange(pobj, leg, text_p, ggplot(), widths=c(6,1), heights =c(6,1))

我很乐意在一项或两项任务上都获得帮助(将样本大小添加为文本并以不同的颜色添加绘制范围之外的值)。

最佳答案

根据您的评论，也许最好的方法是滚动您自己的布局。下面是一个例子。我们将边际图创建为单独的ggplot对象，并将其与主图一起布置。我们还提取图例并将其放置在边际图之外。

建立

library(ggplot2)
library(cowplot)

# Function to extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend) }

thm = list(theme_void(),
           guides(fill=FALSE),
           theme(plot.margin=unit(rep(0,4), "lines")))

xrng = c(0.6,4.4)
yrng = c(53,77)

情节

p1 = ggplot(newdat, aes(x = carat, y = table, fill = predicted_price)) +
  geom_tile() +
  theme_classic() +
  coord_cartesian(xlim=xrng, ylim=yrng)

leg = g_legend(p1)

p1 = p1 + thm[-1]

p2 = ggplot(diamonds, aes(carat)) +
  geom_line(stat="density") +
  thm +
  coord_cartesian(xlim=xrng)

p3 = ggplot(diamonds, aes(table)) +
  geom_line(stat="density") +
  thm +
  coord_flip(xlim=yrng)

plot_grid(
  plot_grid(plotlist=list(p2, ggplot(), p1, p3), ncol=2,
            rel_widths=c(4,1), rel_heights=c(1,4), align="hv", scale=1.1),
  leg, rel_widths=c(5,1))

更新:关于您对地块之间的间距的评论:这是plot_grid的致命弱点，我不知道是否有解决方法。另一个选择是实验性ggarrange包中的egg，它不会在绘图之间添加太多空间。另外，您需要首先保存ggarrange的输出，然后使用图例对保存的对象进行布局。如果在ggarrange中运行grid.arrange，则会得到该图的两个重叠副本:

# devtools::install_github('baptiste/egg')
library(egg)

pobj = ggarrange(p2, ggplot(), p1, p3,
                 ncol=2, widths=c(4,1), heights=c(1,4))

grid.arrange(pobj, leg, widths=c(6,1))