5

I'm writing a package that extends ggplot2. One of those extensions is a geom_arrow() that takes aesthetics mag and angle to plot vector fields by magnitude and direction. I also created a scale_mag() to manipulate the length of the arrows with the prospect of creating also a new guide. Right now both geom and scale work as expected when added together. 

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

But if I don't add scale_mag(), it doesn't work at all. What I want is for this scale to work like scale_color(), which is added by default when the color aesthetic is present.

Here is the code as it is right now:

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 https://stackoverflow.com/questions/47814998/how-to-make-segments-that-preserve-angles-in-different-aspect-ratios-in-ggplot2
      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))
    }
}
Elio Campitelli
  • 1,408
  • 1
  • 10
  • 20
  • Compare it with the source of [`geom_spoke`](https://stackoverflow.com/a/47881159/4497050)? – alistaire Apr 21 '18 at 23:47
  • The functionality of the geom is implemented and works correctly (and it works better than spoke for the use case I'm working on, I hope :P ). The problem is how to tell ggplot2 to use my new scale by default when `mag` is present. – Elio Campitelli Apr 22 '18 at 00:15

3 Answers3

1

I added a default theme to ggplot for a work package by overloading the ggplot function, basically like this:

ggplot <- function(...) {ggplot2::ggplot(...) + your_added_thing()}

If you want it to be less obtrusive, rename your version of ggplot:

jjplot <- function (...) {ggplot2::ggplot(...) + my_added_thing()}
Jon Harmon
  • 803
  • 1
  • 9
  • 20
  • While this will technically work, I think it's not very elegant and user-friendly, since when the user wants to modify `scale_mag()` they will add another call to the scale and receive a confusing message that "Scale for 'mag' is already present". – Elio Campitelli Apr 22 '18 at 16:04
1

Finally, I find the answer!

Based on the code in ggplot2/R/scale-type.R, there should be a scale named scale_mag_continuous in the parent environment of find_scale function. Then, this scale can be find automatically.

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))
microly
  • 26
  • 1
0

this page will be helpful for you.

https://gist.github.com/wch/3250485

especially, the code below:

#This tells ggplot2 what scale to look for, for yearmon

scale_type.yearmon <- function(x) "yearmon"
microly
  • 26
  • 1
  • Thanks! I've believe I remember being there and, while it was very useful for figuring out other stuff, the `scale_type` thing only works if you are using a different class of data. In my case, it's just regular numeric. – Elio Campitelli Sep 21 '18 at 14:32