首页 文章

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

提问于
浏览 次
3

我想在相同的图中显示内插数据和每个预测器的原始数据的直方图 . 我已经在其他线程中看到过，人们解释了如何对散点图中显示的相同数据进行边缘直方图，在这种情况下，直方图是基于其他数据（原始数据） .

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

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

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

library(ggExtra)    
ggMarginal(p)

enter image description here

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

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

enter image description here

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

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

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

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

r plot ggplot2 histogram

1 回答

  • 2

    根据您的评论，也许最好的方法是推出自己的布局 . 以下是一个例子 . 我们将边缘图创建为单独的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))

    enter image description here

    UPDATE: 关于你对地块之间空间的评论：这是 plot_grid 的致命弱点，我不能解决这个问题 . 另一个选项是来自实验 egg 包的 ggarrange ，它不会在图之间添加太多空间 . 此外，您需要首先保存 ggarrange 的输出，然后使用图例布置保存的对象 . 如果你在 grid.arrange 内运行 ggarrange ，你会得到两个重叠的剧情副本：

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

    enter image description here

    回复于

相关问题