如何告诉 ggplot2 使用用户创建的比例来实现新的美感。

Question

我正在编写一个扩展的包ggplot2。这些扩展之一是geom_arrow()需要美观mag并按angle大小和方向绘制矢量场。我还创建了一个scale_mag()来操纵箭头的长度，并希望创建一个新的指南。现在，当添加在一起时，几何和比例都可以按预期工作。

ggplot(geo, aes(lon, lat)) +
    geom_arrow(aes(mag = mag, angle = angle)) +
    scale_mag()

但如果我不添加scale_mag()，它根本不起作用。我想要的是让这个比例像 一样工作，当审美存在scale_color()时默认添加它。color

这是现在的代码：

geom_arrow <- function(mapping = NULL, data = NULL,
                       stat = "arrow",
                       position = "identity", ...,
                       start = 0,
                       direction = 1,
                       # scale = 1,
                       min.mag = 0,
                       skip = 0,
                       skip.x = skip,
                       skip.y = skip,
                       arrow.angle = 15,
                       arrow.length = 0.5,
                       arrow.ends = "last",
                       arrow.type = "closed",
                       arrow = grid::arrow(arrow.angle, unit(arrow.length, "lines"),
                                           ends = arrow.ends, type = arrow.type),
                       lineend = "butt",
                       na.rm = FALSE,
                       show.legend = NA,
                       inherit.aes = TRUE) {
    layer(geom = GeomArrow,
          mapping = mapping,
          data = data,
          stat = stat,
          position = position,
          show.legend = show.legend,
          inherit.aes = inherit.aes,
          params = list(
              start = start,
              direction = direction,
              arrow = arrow,
              lineend = lineend,
              na.rm = na.rm,
              # scale = scale,
              skip.x = skip.x,
              skip.y = skip.y,
              min.mag = min.mag,
              ...)
    )
}

GeomArrow <- ggplot2::ggproto("GeomArrow", Geom,
  required_aes = c("x", "y"),
  default_aes = ggplot2::aes(color = "black", size = 0.5, min.mag = 0,
                             linetype = 1, alpha = NA),
  draw_key = ggplot2::draw_key_path,
  draw_panel = function(data, panel_scales, coord,
                        arrow = arrow, lineend = lineend,
                        start = start, direction = direction,
                        preserve.dir = TRUE) {
      coords <- coord$transform(data, panel_scales)
      unit.delta <- "snpc"
      if (preserve.dir == FALSE) {
          coords$angle <- with(coords, atan2(yend - y, xend - x)*180/pi)
          unit.delta <- "npc"
      }

      coords$dx <- with(coords, mag*cos(angle*pi/180))
      coords$dy <- with(coords, mag*sin(angle*pi/180))

      # from /sf/ask/3347049891/
      xx <- grid::unit.c(grid::unit(coords$x, "npc"),
                         grid::unit(coords$x, "npc") + grid::unit(coords$dx, unit.delta))
      yy <- grid::unit.c(grid::unit(coords$y, "npc"),
                         grid::unit(coords$y, "npc") + grid::unit(coords$dy, unit.delta))


      mag <- with(coords, mag/max(mag, na.rm = T))
      arrow$length <- unit(as.numeric(arrow$length)*mag, attr(arrow$length, "unit"))

      pol <- grid::polylineGrob(x = xx, y = yy,
                                default.units = "npc",
                                arrow = arrow,
                                gp = grid::gpar(col = coords$colour,
                                                fill = scales::alpha(coords$colour, coords$alpha),
                                                alpha = ifelse(is.na(coords$alpha), 1, coords$alpha),
                                                lwd = coords$size*.pt,
                                                lty = coords$linetype,
                                                lineend = lineend),
                                id = rep(seq(nrow(coords)), 2))
      pol
  })


StatArrow <- ggplot2::ggproto("StatArrow", ggplot2::Stat,
    required_aes = c("x", "y"),
    default_aes = ggplot2::aes(min.mag = 0, dx = NULL, dy = NULL,
                               mag = NULL, angle = NULL),
    compute_group = function(data, scales,
                             skip.x = skip.x, skip.y = skip.y,
                             min.mag = min.mag) {
        min.mag <- data$min.mag %||% min.mag

        if (is.null(data$mag) | is.null(data$angle)) {
            if (is.null(data$dx) | is.null(data$dy)) stop("stat_arrow need dx, dy or mag angle (improve mesage!!)")
            data$mag <- with(data, Mag(dx, dy))
            data$angle <- with(data, atan2(dy, dx)*180/pi)
        } else {
            data$dx <- with(data, mag*cos(angle*pi/180))
            data$dy <- with(data, mag*sin(angle*pi/180))
        }

        data <- subset(data, x %in% JumpBy(unique(x), skip.x + 1) &
                             y %in% JumpBy(unique(y), skip.y + 1) &
                             mag >= min.mag)

        data$xend = with(data, x + dx)
        data$yend = with(data, y + dy)
        data

    }
)

scale_mag <- function(length = 0.1,
                      max = waiver(),
                      default_unit = "lines") {
    # if (!is.unit(length)) length <- ggplot2::unit(length, default_unit)

    continuous_scale("mag",
                     "mag",
                     identity,
                     rescaler = rescale_mag(length, max),
                     guide = "none")
}

# scale_type.mag <- function(x) "vector"

rescale_mag <- function(length, max) {
    function(x, from) {
        if (is.waive(max)) max <- max(x, na.rm = T)
        scales::rescale(x, c(0, length), c(0, max))
    }
}

Answer 1

终于，我找到了答案！

根据ggplot2/R/scale-type.R中的代码，应该有一个scale_mag_continuous在函数的父环境中命名的比例find_scale。然后，就可以自动找到这个尺度。

geo <- tibble(lon = 1:10, lat = 1:10, mag = 1:10, angle = 1:10)

scale_mag_continuous <- scale_mag

ggplot(geo, aes(lon, lat)) +
    geom_arrow(aes(mag = mag, angle = angle))