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

Question

我想在相同的图中显示插值数据和每个预测变量的原始数据的直方图。我已经在其他线程中看到过这样的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()

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

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

我很乐意接受任务或两项任务的帮助（将样本大小添加为文本，并在绘制范围之外添加不同颜色的值）。

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