r - 在自定义统计中转义 'discrete aesthetic implies group'

Question

我正在尝试使用 ggplot2 构建一个自定义 stat 函数，其中我想访问一个离散变量来计算每组的统计数据。但是，ggplot 层的默认行为是自动将隐式组分配给任何离散变量(主要是)。这意味着我的数据会通过自动分组进行拆分，这是我不想要的。

我可以显示如下；我有一个非常标准的构造函数:

library(ggplot2)

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

我有一个 Stat ggproto 对象，它只是传递数据，但出于说明目的打印数据的头部。我已经调用了我对计算实际统计数据感兴趣的位 value这里。

StatExample <- ggproto(
  "StatExample",
  Stat,
  required_aes = c("x", "y", "value"),
  default_aes = aes(x = after_stat(x), y = after_stat(y)),
  compute_group = function(data, scales) {
    print(head(data, 2))
    data
  }
)

现在，如果我用这个统计数据构建一个图，我们可以看到 compute_group() 的内容。功能为 data .

g <- ggplot(iris) +
  stat_example(aes(Sepal.Width, Sepal.Length, value = Species))

# To get only the print side-effect, not the plot (which looks normal)
g <- ggplotGrob(g)
#>     x   y  value PANEL group
#> 1 3.5 5.1 setosa     1     1
#> 2 3.0 4.9 setosa     1     1
#>      x   y      value PANEL group
#> 51 3.2 7.0 versicolor     1     2
#> 52 3.2 6.4 versicolor     1     2
#>       x   y     value PANEL group
#> 101 3.3 6.3 virginica     1     3
#> 102 2.7 5.8 virginica     1     3

创建于 2020-05-28 由 reprex package (v0.3.0)

我希望有 1 个 data.frame 包含此案例的所有数据。我们在上面看到我们已经用不同的 group 打印了 3 个 data.frames变量，这意味着数据已被分成 3 组。我认为到达那里需要的是 value变量逃逸自动组检测。

我考虑了以下几点:

我可以让组默认为 -1 ，这是标准的“无组”组。但是，当我这样做时，数据不会自动分组，例如 aes(colour = some_variable) .这是我绝对希望发生的。

看着 ggplot2:::add_group()功能，似乎我可以通过命名我的 value 来逃避自动分组变量 label ，但是这会使统计数据与 geom_text() 不兼容并且它没有描述value的含义自然。

我可以更换 layer()使用此函数的变体调用，这将创建一个不同的层 ggproto 对象，其中 compute_aesthetics()不同的工作组。然而，这是我宁愿避免承担的大量工作。

我可能会按照 vctrs::new_vctr(..., class = "not_discrete") 的方式来耍花招。 ，但是在哪里包装我的value 合适的地方该类中的变量？

欢迎提供有用的建议，或对“只需使用 label”的新看法' 也有争论。

Answer 1

如果这是一个偶然的用例，一个简单的(虽然是手动的)hack 可能正在运行 trace(ggplot2:::add_group, edit = TRUE)并添加 "value"旁边 "label", "PANEL"作为要从自动组检测中排除的变量名称。
实现相同效果的较少手动(但可能更脆弱)的方法将涉及以下步骤:

定义 add_group 的修改版本具有上述修改的功能；

定义 Layer 的修改版本使用修改后的 ggproto 对象 add_group在其 compute_aesthetics功能;

将自定义统计数据指向修改后的图层。

# define modified add_group function
add_group2 <- function (data) {
  if (ggplot2:::empty(data)) 
    return(data)
  if (is.null(data$group)) {
    disc <- vapply(data, ggplot2:::is.discrete, logical(1))
    disc[names(disc) %in% c("label", "PANEL", "value")] <- FALSE         # change here
    if (any(disc)) {
      data$group <- vctrs::vec_group_id(data[disc])
    }
    else {
      data$group <- ggplot2:::NO_GROUP
    }
  } else {
    data$group <- vctrs::vec_group_id(data["group"])
  }
  data
}

# define modified compute_aesthetics function that uses modified add_group in second last line
compute_aesthetics_alt <- .subset2(ggplot2:::Layer, "compute_aesthetics")
body(compute_aesthetics_alt)[[length(body(compute_aesthetics_alt)) - 1]] <- 
  quote(evaled <- add_group2(evaled))

# define modified Layer ggproto object that uses alternative compute_aesthetics
Layer2 <- ggproto("Layer2",
                  ggplot2:::Layer,
                  compute_aesthetics = compute_aesthetics_alt)

# define modified stat with Layer2 specified as its layer_class
stat_example <- function(
  mapping = NULL,
  data = NULL,
  geom = "point",
  position = "identity",
  ...,
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE
) {
  layer(data = data,
        mapping = mapping,
        stat = StatExample,
        geom = geom,
        position = position,
        show.legend = show.legend,
        inherit.aes = inherit.aes,
        params = list(na.rm = na.rm),
        layer_class = Layer2) # change here
}

用法:

# add new column to simulate different colour
iris$gg <- sample(c("a", "b"), size = nrow(iris), replace = TRUE) 

ggplot(iris) + 
  stat_example(aes(Sepal.Width, Sepal.Length,
                   value = Species))
# prints one data frame, because there's only one group by default

ggplot(iris) + 
  stat_example(aes(Sepal.Width, Sepal.Length,
                   value = Species, colour = gg))
# prints two data frames, because grouping is based on the colour aesthetic,
# which has two possible values