从头开始创建geom/stat

Question

我不久前刚开始与R合作,我目前正在努力加强我的可视化技能.我想要做的是创建带有平均钻石的箱形图作为顶层(参见下面链接中的图片).我没有找到任何已经完成此功能的功能,所以我想我必须自己创建它.

我希望做的是创建一个geom或stat,允许这样的东西工作:

ggplot(data, aes(...))) + 
   geom_boxplot(...) +
   geom_meanDiamonds(...)

我不知道从哪里开始构建这个新功能.我知道平均钻石需要哪些值(平均值和置信区间),但我不知道如何构建从中获取数据的geom/stat ggplot(),计算每个组的平均值和CI,并绘制平均值.每个箱图的顶部.

我已经搜索了如何从头开始构建这些类型的函数的详细描述,但是,我还没有找到任何真正从底部开始的东西.我真的很感激,如果有人能指出我一些有用的指南.

谢谢!

Answer 1

我目前正在学习自己编写Geoms，因此在我进行思考的过程中，这将是一篇相当漫长而漫无目的的文章，从Stats方面解开Geom方面（创建多边形和线段）（计算这些多边形的位置） ＆段应该是一个几何。

免责声明：我对这种情节不熟悉，Google并没有提出很多权威性指南。我对这里如何计算/使用置信区间的理解可能不正确。

步骤0。了解geom / stat与图层功能之间的关系。

geom_boxplot和stat_boxplot是的层的功能的例子。如果将它们输入R控制台，则会看到它们相对较短，并且不包含用于计算箱形图的箱形/晶须的实际代码。而是geom_boxplot包含一个包含的行geom = GeomBoxplot，而stat_boxplot包含一个包含的行stat = StatBoxplot（如下所示）。

> stat_boxplot
function (mapping = NULL, data = NULL, geom = "boxplot", position = "dodge2", 
    ..., coef = 1.5, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) 
{
    layer(data = data, mapping = mapping, stat = StatBoxplot, 
        geom = geom, position = position, show.legend = show.legend, 
        inherit.aes = inherit.aes, params = list(na.rm = na.rm, 
            coef = coef, ...))
}

GeomBoxplot和StatBoxplot是ggproto对象。它们就是魔术发生的地方。

步骤1.确认ggproto()的_inherit参数是您的朋友。

不要重新发明轮子。由于我们要创建与箱形图很好地重叠的内容，因此我们可以从用于该内容的Geom / Stat中获取参考，仅更改必要的内容。

StatMeanDiamonds <- ggproto(
  `_class` = "StatMeanDiamonds",
  `_inherit` = StatBoxplot,
  ... # add functions here to override those defined in StatBoxplot
)

GeomMeanDiamonds <- ggproto(
  `_class` = "GeomMeanDiamonds",
  `_inherit` = GeomBoxplot,
  ... # as above
)

步骤2.修改统计信息。

有内StatBoxplot定义3个功能：setup_data，setup_params，和compute_group。您可以参考Github（上面的链接）上的代码以获取详细信息，或通过输入example来查看它们StatBoxplot$compute_group。

该compute_group函数为与每个组关联的所有y值（即每个唯一的x值）计算ymin /较低/中间/较高/ ymax值，用于绘制箱形图。我们可以用一个代替它来计算置信区间和平均值：

# ci is added as a parameter, to allow the user to specify different confidence intervals
compute_group_new <- function(data, scales, width = NULL, 
                              ci = 0.95, na.rm = FALSE){
  a <- mean(data$y)
  s <- sd(data$y)
  n <- sum(!is.na(data$y))
  error <- qt(ci + (1-ci)/2, df = n-1) * s / sqrt(n)
  stats <- c("lower" = a - error, "mean" = a, "upper" = a + error)

  if(length(unique(data$x)) > 1) width <- diff(range(data$x)) * 0.9

  df <- as.data.frame(as.list(stats))

  df$x <- if(is.factor(data$x)) data$x[1] else mean(range(data$x))
  df$width <- width

  df
}

（可选）StatBoxplot提供了供用户包括weight为美观映射的条件。我们也可以通过替换为：

  a <- mean(data$y)
  s <- sd(data$y)
  n <- sum(!is.na(data$y))

与：

  if(!is.null(data$weight)) {
    a <- Hmisc::wtd.mean(data$y, weights = data$weight)
    s <- sqrt(Hmisc::wtd.var(data$y, weights = data$weight))
    n <- sum(data$weight[!is.na(data$y) & !is.na(data$weight)])
  } else {
    a <- mean(data$y)
    s <- sd(data$y)
    n <- sum(!is.na(data$y))
  }

无需更改StatBoxplot中的其他功能。因此，我们可以按以下方式定义StatMeanDiamonds：

StatMeanDiamonds <- ggproto(
  `_class` = "StatMeanDiamonds",
  `_inherit` = StatBoxplot,
  compute_group = compute_group_new
)

步骤3.修改Geom。

GeomBoxplot有3个功能：setup_data，draw_group，和draw_key。它还包括default_aes()和的定义required_aes()。

由于我们已经更改了上游数据源（StatMeanDiamonds生成的数据包含计算出的列“ lower” /“ mean” /“ upper”，而StatBoxplot生成的数据将包含计算出的列“ ymin” /“ lower” /“中间” /“上部” /“ ymax”），请检查下游setup_data功能是否也受到影响。（在这种情况下，GeomBoxplot$setup_data不引用受影响的列，因此此处无需进行任何更改。）

该draw_group函数获取由StatMeanDiamonds生成并由设置的数据setup_data，并生成多个数据帧。“公用”包含所有几何图形共有的美学映射。“ diamond.df”表示有助于钻石多边形的映射，“ segment.df”表示有助于平均水平线段的映射。然后将数据帧分别传递给draw_panelGeomPolygon和GeomSegment函数，以生成实际的多边形/线段。

draw_group_new = function(data, panel_params, coord,
                      varwidth = FALSE){
  common <- data.frame(colour = data$colour, 
                       size = data$size,
                       linetype = data$linetype, 
                       fill = alpha(data$fill, data$alpha),
                       group = data$group, 
                       stringsAsFactors = FALSE)
  diamond.df <- data.frame(x = c(data$x, data$xmax, data$x, data$xmin),
                           y = c(data$upper, data$mean, data$lower, data$mean),
                           alpha = data$alpha,
                           common,
                           stringsAsFactors = FALSE)
  segment.df <- data.frame(x = data$xmin, xend = data$xmax,
                           y = data$mean, yend = data$mean,
                           alpha = NA,
                           common,
                           stringsAsFactors = FALSE)
  ggplot2:::ggname("geom_meanDiamonds",
                   grid::grobTree(
                     GeomPolygon$draw_panel(diamond.df, panel_params, coord),
                     GeomSegment$draw_panel(segment.df, panel_params, coord)
                   ))
}

如果需要，该draw_key函数用于为该层创建图例。由于从GeomBoxplot GeomMeanDiamonds继承，默认的是draw_key = draw_key_boxplot，我们不都去改变它。保持不变不会破坏代码。但是，我认为更简单的图例（例如，draw_key_polygon外观）不太混乱。

GeomBoxplot的default_aes规格看起来不错。但是我们需要更改，required_aes因为我们希望从StatMeanDiamonds获得的数据是不同的（“较低” /“平均” /“较高”，而不是“ ymin” /“较低” /“中间” /“较高” /“ ymax” ）。

现在我们可以定义GeomMeanDiamonds了：

GeomMeanDiamonds <- ggproto(
  "GeomMeanDiamonds",
  GeomBoxplot,
  draw_group = draw_group_new,
  draw_key = draw_key_polygon,
  required_aes = c("x", "lower", "upper", "mean")
)

步骤4.定义图层功能。

这是无聊的部分。我直接从geom_boxplot/ 复制stat_boxplot，删除了所有对异常值的引用geom_meanDiamonds，更改为geom = GeomMeanDiamonds/ stat = StatMeanDiamonds，然后添加ci = 0.95为stat_meanDiamonds。

geom_meanDiamonds <- function(mapping = NULL, data = NULL,
                              stat = "meanDiamonds", position = "dodge2",
                              ..., varwidth = FALSE, na.rm = FALSE, show.legend = NA,
                              inherit.aes = TRUE){
  if (is.character(position)) {
    if (varwidth == TRUE) position <- position_dodge2(preserve = "single")
  } else {
    if (identical(position$preserve, "total") & varwidth == TRUE) {
      warning("Can't preserve total widths when varwidth = TRUE.", call. = FALSE)
      position$preserve <- "single"
    }
  }
  layer(data = data, mapping = mapping, stat = stat,
        geom = GeomMeanDiamonds, position = position,
        show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(varwidth = varwidth, na.rm = na.rm, ...))
}

stat_meanDiamonds <- function(mapping = NULL, data = NULL,
                         geom = "meanDiamonds", position = "dodge2",
                         ..., ci = 0.95,
                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {
  layer(data = data, mapping = mapping, stat = StatMeanDiamonds,
        geom = geom, position = position, show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, ci = ci, ...))
}

步骤5.检查输出。

# basic
ggplot(iris, 
       aes(Species, Sepal.Length)) +
  geom_boxplot() +
  geom_meanDiamonds()

# with additional parameters, to see if they break anything
ggplot(iris, 
       aes(Species, Sepal.Length)) +
  geom_boxplot(width = 0.8) +
  geom_meanDiamonds(aes(fill = Species),
                    color = "red", alpha = 0.5, size = 1, 
                    ci = 0.99, width = 0.3)