Custom ggplot2 geom that plots a (subset of a) vector field

ggplot2_geomvector.R

library(ggplot2)
library(dplyr)
library(tibble)
library(tidyr)

GeomVector <- ggproto("GeomVector", Geom,

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

  default_aes = aes(
    colour = "black", fill = NA, size = .025,
    linetype = 1, alpha = 1, linewidth = 1
  ),

  draw_key = draw_key_point,

  draw_panel = function(data, panel_params, coord) {
    coords <- coord$transform(data, panel_params)
    #maxlen <- .025
    headang <- 30
    grid::polylineGrob(
      x = c(coords$x, coords$x + coords$length * coords$size * cos(2*pi*coords$direction/360)),
      y = c(coords$y, coords$y + coords$length * coords$size * sin(2*pi*coords$direction/360)),
      id = c(1:length(coords$x), 1:length(coords$x)),
      arrow = arrow(
        angle = headang,
        length = unit(coords$size * coords$length/2, "native")),
      default.units = "native",
      gp = grid::gpar(
        col = coords$colour,
        lwd = coords$linewidth)
    )
  }
)


geom_vector <- function(
  mapping = NULL,
  data = NULL,
  stat = "identity",
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE,
  ...) {

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



# create a silly vector field
field <- tibble(
  xval = seq(-pi, pi-pi/16, pi/16),
  yval = seq(0, pi-pi/32, pi/32)
) %>%
  expand(xval, yval) %>%
  mutate(
    dir = sin(xval)*180/pi,
    len = abs(sin(yval)),
    cosx = cos(xval)
  )

# plot a random subset of the vector field
pic <- field %>%
  sample_n(300) %>%
  ggplot(aes(x = xval, y = yval, direction = dir, length = len, colour = cosx)) +
  geom_vector(linewidth = 2, show.legend = FALSE) +
  theme_void()

plot(pic)
#ggsave("~/../Desktop/vector_field.png")