r - ggplot : percentile lines by group automation

Question

我发现 dplyr %>% 运算符有助于简单的 ggplot2 转换(无需求助于 ggplot2 extensions 所需的 ggproto) )，例如

library(ggplot2)
library(scales)
library(dplyr)

gg.histo.pct.by.group <- function(g, ...) {
  g + 
    geom_histogram(aes(y=unlist(lapply(unique(..group..), function(grp) ..count..[..group..==grp] / sum(..count..[..group..==grp])))), ...) +
    scale_y_continuous(labels = percent) + 
    ylab("% of total count by group")
}

data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))

g = ggplot(data, aes(carat, fill=color)) %>% 
  gg.histo.pct.by.group(binwidth=0.5, position="dodge")

向这些类型的图表添加一些带有标签的百分位数线是很常见的，例如，

执行此操作的一种剪切和粘贴方法是

facts = data %>% 
  group_by(color) %>% 
  summarize(
    p50=quantile(carat, 0.5, na.rm=T), 
    p90=quantile(carat, 0.9, na.rm=T)
  )

ymax = ggplot_build(g)$panel$ranges[[1]]$y.range[2]

g +
  geom_vline(data=facts, aes(xintercept=p50, color=color), linetype="dashed", size=1) +
  geom_vline(data=facts, aes(xintercept=p90, color=color), linetype="dashed", size=1) +
  geom_text(data=facts, aes(x=p50, label=paste("p50=", p50), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90) +
  geom_text(data=facts, aes(x=p90, label=paste("p90=", p90), y=ymax, color=color), vjust=1.5, hjust=1, size=4, angle=90)

我很想将其封装成类似 g %>% gg.percentile.x(c(.5, .9)) 但我一直没能找到一个好的将 aes_ 或 aes_string 的使用与图形对象中分组列的发现相结合的方法，以便正确计算百分位数。我希望得到一些帮助。

Answer 1

我认为创建所需绘图的最有效方法包括三个步骤:

1. 编写两个单独的简单统计数据(遵循 https://cran.r-project.org/web/packages/ggplot2/vignettes/extending-ggplot2.html 的创建新统计数据部分):一个用于在百分位数位置添加垂直线，另一个用于添加文本标签；
2. 根据需要将刚刚写入的统计数据与参数合并到所需的统计数据中；
3. 使用工作成果。

所以答案也由 3 部分组成。

第 1 部分。在百分位数位置添加垂直线的统计数据应根据 x 轴中的数据计算这些值，并以适当的格式返回结果。这是代码:

library(ggplot2)

StatPercentileX <- ggproto("StatPercentileX", Stat,
  compute_group = function(data, scales, probs) {
    percentiles <- quantile(data$x, probs=probs)
    data.frame(xintercept=percentiles)
    },
  required_aes = c("x")
)

stat_percentile_x <- function(mapping = NULL, data = NULL, geom = "vline",
                              position = "identity", na.rm = FALSE,
                              show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileX, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

添加文本标签的统计数据也是如此(默认位置位于图的顶部):

StatPercentileXLabels <- ggproto("StatPercentileXLabels", Stat,
  compute_group = function(data, scales, probs) {
    percentiles <- quantile(data$x, probs=probs)
    data.frame(x=percentiles, y=Inf,
               label=paste0("p", probs*100, ": ",
                            round(percentiles, digits=3)))
    },
  required_aes = c("x")
)

stat_percentile_xlab <- function(mapping = NULL, data = NULL, geom = "text",
                                     position = "identity", na.rm = FALSE,
                                     show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileXLabels, data = data, mapping = mapping, geom = geom, 
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

我们已经拥有非常强大的工具，可以以 ggplot2 提供的任何方式使用(着色、分组、分面等)。例如:

set.seed(1401)
plot_points <- data.frame(x_val=runif(100), y_val=runif(100),
                          g=sample(1:2, 100, replace=TRUE))
ggplot(plot_points, aes(x=x_val, y=y_val)) +
  geom_point() +
  stat_percentile_x(probs=c(0.25, 0.5, 0.75), linetype=2) +
  stat_percentile_xlab(probs=c(0.25, 0.5, 0.75), hjust=1, vjust=1.5, angle=90) +
  facet_wrap(~g)
# ggsave("Example_stat_percentile.png", width=10, height=5, units="in")

第 2 部分 虽然为线条和文本标签保留单独的图层似乎很自然(尽管两次计算百分位数的计算效率有点低)，但每次添加两个图层都相当冗长。特别是对于这个 ggplot2 ，有一种简单的组合图层的方法:将它们放入结果函数调用的列表中。代码如下:

stat_percentile_x_wlabels <- function(probs=c(0.25, 0.5, 0.75)) {
  list(
    stat_percentile_x(probs=probs, linetype=2),
    stat_percentile_xlab(probs=probs, hjust=1, vjust=1.5, angle=90)
  )
}

使用此函数，可以通过以下命令重现前面的示例:

ggplot(plot_points, aes(x=x_val, y=y_val)) +
  geom_point() +
  stat_percentile_x_wlabels() +
  facet_wrap(~g)

请注意，stat_percentile_x_wlabels 获取所需百分位数的概率，然后将其传递给 quantile 函数。这是指定它们的地方。

第 3 部分再次使用组合图层的想法，您问题中的图可以重现如下:

library(scales)
library(dplyr)

geom_histo_pct_by_group <- function() {
  list(geom_histogram(aes(y=unlist(lapply(unique(..group..),
                                          function(grp) {
                                            ..count..[..group..==grp] /
                                              sum(..count..[..group..==grp])
                                            }))),
                      binwidth=0.5, position="dodge"),
         scale_y_continuous(labels = percent),
         ylab("% of total count by group")
       )
}

data = diamonds %>% select(carat, color) %>% filter(color %in% c('H', 'D'))

ggplot(data, aes(carat, fill=color, colour=color)) +
  geom_histo_pct_by_group() +
  stat_percentile_x_wlabels(probs=c(0.5, 0.9))
# ggsave("Question_plot.png", width=10, height=6, unit="in")

备注

1. 此处解决此问题的方式允许使用百分位线和标签构建更复杂的绘图；

2. 将 x 更改为 y(反之亦然)，将 vline 更改为 hline，xintercept 到 yintercept 在适当的位置，我们可以为 y 轴的数据定义相同的统计数据；

3. 当然，如果您喜欢使用 %>% 而不是 ggplot2 的 +，您可以将定义的统计数据包装在函数中就像你在问题帖子中所做的那样。就我个人而言，我不建议这样做，因为它违背了 ggplot2 的标准使用。