在 ggplot2 (R) 中使用 coord_pol() 时在任意两点之间绘制直线

Question

我有一个使用极坐标的图。现在我想使用直箭头向该图添加一些注释geom_segment()。但是，当我使用 时coord_polar()，正如预期的那样，这些线段也会转换为极坐标系。当然，这是适当的行为，但我想在图中添加一些直箭头（在笛卡尔意义上）。我怎样才能最好地做到这一点。这两个问题让我很接近，但还没有（R：如何将多边形的直线和线段与极坐标结合起来？和将线段添加到具有雷达坐标的ggplot2中的直方图中）。对于我的绘图的解决方案，我不能使用 coord_radar 代替。

这在没有 coord_pol 的情况下有效，但在没有 coord_pol 的情况下则无效

library(tidyverse)
df <- tibble(x = rep(letters,  each = 5),
             y = rep(1:5, 26),
             d =  rnorm(26 * 5))


p1 <- ggplot() +
  geom_tile(data = df,
            aes(x = x,
                y = y,
                fill = d)) +
  ylim(c(-2, 5)) +
  geom_segment(
    aes(
      x = "o",
      y = -1,
      xend = "z",
      yend = 3
    ),
    arrow = arrow(length = unit(0.2, "cm")),
    col = "red",
    size = 2
  ) 
p1

p1 + coord_polar()

Answer 1

恐怕这会比乍看起来更加痛苦。本质上，您必须为分段编写一个新的面板绘制方法，忽略坐标系统是否是线性的。为此，您可以根据 执行以下操作GeomSegment$draw_panel：

library(tidyverse)

geom_segment_straight <- function(...) {
  layer <- geom_segment(...)
  new_layer <- ggproto(NULL, layer)
  old_geom <- new_layer$geom
  geom <- ggproto(
    NULL, old_geom,
    draw_panel = function(data, panel_params, coord, 
                          arrow = NULL, arrow.fill = NULL,
                          lineend = "butt", linejoin = "round",
                          na.rm = FALSE) {
      data <- ggplot2:::remove_missing(
        data, na.rm = na.rm, c("x", "y", "xend", "yend", 
                               "linetype", "size", "shape")
      )
      if (ggplot2:::empty(data)) {
        return(zeroGrob())
      }
      coords <- coord$transform(data, panel_params)
      # xend and yend need to be transformed separately, as coord doesn't understand
      ends <- transform(data, x = xend, y = yend)
      ends <- coord$transform(ends, panel_params)
      
      arrow.fill <- if (!is.null(arrow.fill)) arrow.fill else coords$colour
      return(grid::segmentsGrob(
        coords$x, coords$y, ends$x, ends$y,
        default.units = "native", gp = grid::gpar(
          col = alpha(coords$colour, coords$alpha),
          fill = alpha(arrow.fill, coords$alpha),
          lwd = coords$size * .pt,
          lty = coords$linetype,
          lineend = lineend,
          linejoin = linejoin
        ),
        arrow = arrow
      ))
      
    }
  )
  new_layer$geom <- geom
  return(new_layer)
}

然后你就可以像任何其他几何图形一样使用它。

ggplot() +
  geom_tile(data = df,
            aes(x = x,
                y = y,
                fill = d)) +
  ylim(c(-2, 5)) +
  geom_segment_straight(
    aes(
      x = "o",
      y = -1,
      xend = "z",
      yend = 3
    ),
    arrow = arrow(length = unit(0.2, "cm")),
    col = "red",
    size = 2
  ) + 
  coord_polar()

编辑：geom_curve()

这是同样的技巧应用于geom_curve()：

library(tidyverse)

geom_segment_straight <- function(...) {
  layer <- geom_segment(...)
  new_layer <- ggproto(NULL, layer)
  old_geom <- new_layer$geom
  geom <- ggproto(
    NULL, old_geom,
    draw_panel = function(data, panel_params, coord, 
                          arrow = NULL, arrow.fill = NULL,
                          lineend = "butt", linejoin = "round",
                          na.rm = FALSE) {
      data <- ggplot2:::remove_missing(
        data, na.rm = na.rm, c("x", "y", "xend", "yend", 
                               "linetype", "size", "shape")
      )
      if (ggplot2:::empty(data)) {
        return(zeroGrob())
      }
      coords <- coord$transform(data, panel_params)
      # xend and yend need to be transformed separately, as coord doesn't understand
      ends <- transform(data, x = xend, y = yend)
      ends <- coord$transform(ends, panel_params)
      
      arrow.fill <- if (!is.null(arrow.fill)) arrow.fill else coords$colour
      return(grid::segmentsGrob(
        coords$x, coords$y, ends$x, ends$y,
        default.units = "native", gp = grid::gpar(
          col = alpha(coords$colour, coords$alpha),
          fill = alpha(arrow.fill, coords$alpha),
          lwd = coords$size * .pt,
          lty = coords$linetype,
          lineend = lineend,
          linejoin = linejoin
        ),
        arrow = arrow
      ))
      
    }
  )
  new_layer$geom <- geom
  return(new_layer)
}

geom_segment_straight()替换为后，上面的结果如下geom_curve_polar()：

小提示：这种制作新几何图形的方法是快速而肮脏的方法。如果你打算正确地做到这一点，你应该分别编写构造函数和 ggproto 类。