1

我的目标是编写一个自定义geom_方法来计算和绘制，例如置信区间，这些应该绘制为多边形或线条。现在的问题是，在哪里检查应该绘制哪种“样式”？

到目前为止，我已经尝试了三种不同的方法，

  • (i) 写两个不同的geom_/stat_用于线和多边形样式的图，
  • (ii) 编写一个使用自定义的geom_/ ，stat_GeomMethod
  • (iii) 写一个geom_/stat_它使用GeomPolygonor GeomLine。

在我看来，总结一下

  • (i) 或多或少直截了当，但只是绕过了问题，
  • (ii) 当您使用GeomPath$draw_panel()或GeomPolygon$draw_panel()依赖额外参数时有效style。但是在这里我无法default_aes根据额外的参数进行设置style。比较这里的答案。
  • (iii) 调用时有效，geom_但调用失败，因为ggplot2stat_中的名称匹配失败。请参阅下面的最小示例。

设置方法（iii）的方法：

geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
                            position = "identity", na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE,
                            style = c("polygon", "line"), ...) {
  style <- match.arg(style)

  ggplot2::layer(
    geom = if (style == "line") GeomPath else GeomPolygon,
    mapping = mapping,
    data = data,
    stat = stat,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      style = style,
      ...
    )
  )
}

stat_my_confint <- function(mapping = NULL, data = NULL, geom = "my_confint",
                            position = "identity", na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE,
                            style = c("polygon", "line"), ...) {

  style <- match.arg(style)

  ggplot2::layer(
    geom = geom, 
    stat = StatMyConfint,
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      style = style,
      ...
    )
  )
}

StatMyConfint <- ggplot2::ggproto("StatMyConfint", ggplot2::Stat,
  compute_group = function(data, scales, style) {
    if (style == "polygon") {
      nd <- data.frame(
        x = c(data$x, rev(data$x)),
        y = c(data$y - 1, rev(data$y) + 1)
      )
      nd
    } else {
      nd <- data.frame(
        x = rep(data$x, 2),
        y = c(data$y - 1, data$y + 1),
        group = c(rep(1, 5), rep(2, 5))
      )
      nd
    }
  },
  
  required_aes = c("x", "y")
)

尝试方法（iii）的方法：

library("ggplot2")

d <- data.frame(
  x = seq(1, 5),
  y = seq(1, 5)
)

ggplot(d, aes(x = x, y = y)) + geom_line() + geom_my_confint(style = "polygon", alpha = 0.2)
ggplot(d, aes(x = x, y = y)) + geom_line() + geom_my_confint(style = "line", linetype = 2)

到目前为止，这运作良好。但是，调用时stat_会出现错误，ggplot2:::check_subclass因为没有GeomMyConfint方法。

ggplot(d, aes(x = x, y = y)) + geom_line() + stat_my_confint()
# Error: Can't find `geom` called 'my_confint'

任何替代方法的解决方案或建议？

4

2 回答 2

1

根据@teunbrand 的回答以及如何geom_sf()实施，我提出了以下解决方案支持方法（ii）：

geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
                            position = "identity", na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE,
                            type = c("polygon", "line"), ...) {
  type <- match.arg(type)

  ggplot2::layer(
    geom = GeomMyConfint,
    mapping = mapping,
    data = data,
    stat = stat,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      type = type,
      ...
    )
  )
}


GeomMyConfint <- ggplot2::ggproto("GeomMyConfint", ggplot2::Geom,

  ## Setting up all defaults needed for `GeomPolygon` and `GeomPath`
  default_aes = ggplot2::aes(
    colour = NA,
    fill = NA,
    size = NA,
    linetype = NA,
    alpha = NA,
    subgroup = NULL
  ),

  draw_panel = function(data, panel_params, coord,
                        rule = "evenodd", # polygon arguments
                        lineend = "butt", linejoin = "round", # line arguments
                        linemitre = 10, na.rm = FALSE, arrow = NULL, # line arguments
                        type = c("polygon", "line")) {
    type <- match.arg(type)

    ## Swap NAs in `default_aes` with own defaults 
    data <- my_modify_list(data, my_default_aesthetics(type), force = FALSE)

    if (type == "polygon") {
      GeomPolygon$draw_panel(data, panel_params, coord, rule)
    } else {
      GeomPath$draw_panel(data, panel_params, coord,
                          arrow, lineend, linejoin, linemitre, na.rm)
    }

  },

  draw_key = function(data, params, size) {
    ## Swap NAs in `default_aes` with own defaults 
    data <- my_modify_list(data, my_default_aesthetics(params$type), force = FALSE)
    if (params$type == "polygon") {
      draw_key_polygon(data, params, size)
    } else {
      draw_key_path(data, params, size)
    }
  }
)


## Helper function inspired by internal from `ggplot2` defined in `performance.R`
my_modify_list <- function(old, new, force = FALSE) {

  if (force) {
    for (i in names(new)) old[[i]] <- new[[i]]
  } else {
    for (i in names(new)) old[[i]] <- if (all(is.na(old[[i]]))) new[[i]] else old[[i]]
  }

  old
}


## Helper function inspired by internal from `ggplot2` defined in `geom-sf.R`
my_default_aesthetics <- function(type) {
  if (type == "line") {
    my_modify_list(GeomPath$default_aes, list(colour = "red", linetype = 2), force = TRUE)
  } else {
    my_modify_list(GeomPolygon$default_aes, list(fill = "red", alpha = 0.2), force = TRUE)
  }
}

我保持stat_my_confint()and StatMyConfint()from above 不变（style现在type根据命名 w/i仅调用参数geom_sf()）：

stat_my_confint <- function(mapping = NULL, data = NULL, geom = "my_confint",
                            position = "identity", na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE,
                            type = c("polygon", "line"), ...) {

  type <- match.arg(type)

  ggplot2::layer(
    geom = geom,
    stat = StatMyConfint,
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      type = type,
      ...
    )
  )
}


StatMyConfint <- ggplot2::ggproto("StatMyConfint", ggplot2::Stat,
  compute_group = function(data, scales, type) {
    if (type == "polygon") {
      nd <- data.frame(
        x = c(data$x, rev(data$x)),
        y = c(data$y - 1, rev(data$y) + 1)
      )
      nd
    } else {
      nd <- data.frame(
        x = rep(data$x, 2),
        y = c(data$y - 1, data$y + 1),
        group = c(rep(1, 5), rep(2, 5))
      )
      nd
    }
  },

  required_aes = c("x", "y")
)

现在上面的例子工作正常：

library("ggplot2")

d1 <- data.frame(
  x = seq(1, 5),
  y = seq(1, 5)
)

ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint()
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "line")
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "polygon", alpha = 0.8)
ggplot(d1, aes(x = x, y = y)) + geom_line() + geom_my_confint(type = "line", linetype = 4, colour = "red")


ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint()
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "line")
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "polygon", alpha = 0.8)
ggplot(d1, aes(x = x, y = y)) + geom_line() + stat_my_confint(type = "line", linetype = 4, colour = "red")

但是，如果您需要额外的解决方案仍然会失败，例如，fill通过外部分组变量设置多边形的颜色：

d2 <- data.frame(
  x = rep(seq(1, 5), 2),
  y = rep(seq(1, 5), 2),
  z = factor(c(rep(1, 5), rep(2, 5)))
)

ggplot(d2, aes(x = x, y = y)) + geom_line() + geom_my_confint() + facet_wrap(.~z)
# no error

ggplot(d2, aes(x = x, y = y, fill = z)) + geom_line() + geom_my_confint() + facet_wrap(.~z)
# Error in grid.Call.graphics(C_setviewport, vp, TRUE) : 
#  non-finite location and/or size for viewport

所以仍然没有完美的答案。帮助/扩展赞赏！

编辑：

size如果参数设置为0.5within ，则不再发生错误GeomMyConfint$default_aes()：

  • 我不清楚为什么 - 任何人？！
  • 在这里，这是可行的，因为我没有更改or的默认size值，但否则会出现问题。GeomPolygonGeomPath
  • 我没有发现更多错误（目前）。

改编后的代码：

GeomMyConfint <- ggplot2::ggproto("GeomMyConfint", ggplot2::Geom,

  ## Setting up all defaults needed for `GeomPolygon` and `GeomPath`
  default_aes = ggplot2::aes(
    colour = NA,
    fill = NA,
    size = 0.5,
    linetype = NA,
    alpha = NA,
    subgroup = NULL
  ),
  
  draw_panel = function(data, panel_params, coord,
                        rule = "evenodd", # polygon arguments
                        lineend = "butt", linejoin = "round", # line arguments
                        linemitre = 10, na.rm = FALSE, arrow = NULL, # line arguments
                        type = c("polygon", "line")) {
    type <- match.arg(type)
    
    ## Swap NAs in `default_aes` with own defaults 
    data <- my_modify_list(data, my_default_aesthetics(type), force = FALSE)
    
    if (type == "polygon") {
      GeomPolygon$draw_panel(data, panel_params, coord, rule)
    } else {
      GeomPath$draw_panel(data, panel_params, coord,
                          arrow, lineend, linejoin, linemitre, na.rm)
    }
    
  },
  
  draw_key = function(data, params, size) {
    ## Swap NAs in `default_aes` with own defaults 
    data <- my_modify_list(data, my_default_aesthetics(params$type), force = FALSE)
    if (params$type == "polygon") { 
      draw_key_polygon(data, params, size)
    } else {
      draw_key_path(data, params, size)
    }
  }
)

剧情：

ggplot(d2, aes(x = x, y = y, fill = z)) + geom_line() + geom_my_confint() + facet_wrap(.~z)

在此处输入图像描述

于 2021-10-13T11:17:01.747 回答
1

以下不是很优雅，但似乎有效。让我们定义以下构造函数，其中geom设置为GeomMyConfint，我们将在下面进一步定义。

geom_my_confint <- function(mapping = NULL, data = NULL, stat = "my_confint",
                            position = "identity", na.rm = FALSE,
                            show.legend = NA, inherit.aes = TRUE,
                            style = c("polygon", "line"), ...) {
  style <- match.arg(style)
  
  ggplot2::layer(
    geom = GeomMyConfint,
    mapping = mapping,
    data = data,
    stat = stat,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(
      na.rm = na.rm,
      style = style,
      ...
    )
  )
}

下面是配对的 ggproto 类。我已经修改了use_defaults用一些文本替换默认颜色的方法。然后，该draw_panel()方法根据参数选择实际的默认值来替换我们之前插入的文本style。

GeomMyConfint <- ggproto(
  "GeomMyConfint", GeomPolygon,

  # Tag colour if it has been defaulted
  use_defaults = function(self, data, params = list(), modifiers = aes()) {
    has_colour <- "colour" %in% names(data) || "colour" %in% names(params)
    data <- ggproto_parent(GeomPolygon, self)$use_defaults(
      data, params, modifiers
    )
    if (!has_colour) {
      data$colour <- "default_colour"
    }
    data
  },

  # Resolve colour defaults here
  draw_panel = function(
    data, panel_params, coord, 
    # Polygon arguments
    rule = "evenodd", 
    # Line arguments
    lineend = "butt", linejoin = "round", linemitre = 10, 
    na.rm = FALSE, arrow = NULL,
    # Switch argument
    style = "polygon") 
  {
    if (style == "polygon") {
      data$colour[data$colour == "default_colour"] <- NA
      GeomPolygon$draw_panel(data, panel_params, coord, rule)
    } else {
      data$colour[data$colour == "default_colour"] <- "black"
      GeomPath$draw_panel(data, panel_params, coord, 
                          arrow, lineend, linejoin, linemitre, na.rm)
    }
  }
)

然后使用示例中的其余功能。

一种更优雅的方法可能是使用该vctrs包为易于识别的默认值定义一个自定义 S3 类，但我之前没有见过有人尝试使用aes(colour = I("default_colour"))，所以除了这个单一的边缘情况之外，你可能是安全的.

于 2021-10-06T16:08:53.283 回答