Search code examples
rggplot2mappinglegendr-sf

Rotating/angle of ggplot key_glpyh, custom legend key glyph

I am trying to emulate a plot style ive seen online, created by Chris Canipe (https://www.axios.com/2017/12/15/the-flow-of-goods-between-states-1513304375). Looking at trade flows, I've managed to create the the general map I would like, however im unable to create a legend style like the one used by Chris on his plots.

Ive tried changing the "key_glyph" to all the various styles that are offered, but none seem to do what id like. The closest ive gotten so far is to use the "draw_key_vline", which is almost perfect, just needs rotating 90 degree (is this possible?!). Another option ive tried is "draw_key_rect", but while this is close, the size of the rects are all the same, and id like them to scale to the value of the trade flow, as outputs when using the vline option. Any one have any ideas?!

library(tidyverse)
library(ggarrow)
library(rnaturalearth)

countries <- ne_countries(scale = "medium", returnclass = "sf")
  
data <- data.frame(
    From = c("Australia", "Belize", "China", "Cook Islands", "Fiji"),
    from_x   = c(133.77514, -88.49765, 104.19540, -159.77767, 179.41441),
    from_y   = c(-25.274398, 17.189877, 35.861660, -21.236736, -16.578193),
    to_y   = c(40.67778, 40.67778, 40.67778, 40.67778, 40.67778),
    to_x = c(-74.04425, -74.04425, -74.04425, -74.04425, -74.04425),
    trade_val = c(c(275, 66, 126755, 700, 19000)))


ggplot(data = data)+
  geom_sf(data = countries)+
  geom_arrow_curve(data = data, show.legend = T, aes(x = from_x, y = from_y , xend = to_x, yend = to_y, linewidth = trade_val, alpha = trade_val),
                   angle = 90, lineend = "butt", length = unit(0.5, "cm"), colour = "#08519B", key_glyph = draw_key_vline)+
  theme(legend.position = "top",
        legend.text.position = "bottom",
        legend.key.spacing.x = unit(-1.5, "cm"),
        legend.text = element_text(margin = margin(r = 0, unit = "pt")),
        panel.background = element_rect(fill = 'white', colour = 'white'),
        plot.background = element_rect(fill = 'white', colour = 'white'),
        legend.title =element_text(hjust = 0.5))+
  guides(alpha = guide_legend(title = "Trade flow",   label.position = "bottom", ),
         linewidth = guide_legend(title = "Trade flow", title.position =  "top",
                                  label.position = "bottom", keywidth = 6))
Solution

  • You can achieve your desired result using a custom draw_key_xxx function where I simply copy & pasted draw_key_vline but switched the x and y coordinates for the segmentsGrob:

    library(ggplot2)
library(ggarrow)
library(grid)

# Copy & Paste from draw_key_vline
draw_key_cust <- function(data, params, size) {
  grid::segmentsGrob(0, 0.5, 1, .5,
    gp = grid::gpar(col = alpha(data$colour %||%
      data$fill %||% "black", data$alpha), lwd = (data$linewidth %||%
      0.5) * .pt, lty = data$linetype %||% 1, lineend = params$lineend %||%
      "butt")
  )
}

ggplot(data = data) +
  geom_sf(data = countries) +
  geom_arrow_curve(
    data = data, show.legend = T, aes(x = from_x, y = from_y, xend = to_x, yend = to_y, linewidth = trade_val, alpha = trade_val),
    angle = 90,
    lineend = "butt",
    length = unit(0.5, "cm"),
    colour = "#08519B",
    key_glyph = draw_key_cust
  ) +
  theme(
    legend.position = "top",
    legend.text.position = "bottom",
    legend.key.spacing.x = unit(-1.5, "cm"),
    legend.text = element_text(margin = margin(r = 0, unit = "pt")),
    panel.background = element_rect(fill = "white", colour = "white"),
    plot.background = element_rect(fill = "white", colour = "white"),
    legend.title = element_text(hjust = 0.5)
  ) +
  guides(
    alpha = guide_legend(title = "Trade flow", label.position = "bottom", ),
    linewidth = guide_legend(
      title = "Trade flow", title.position = "top",
      label.position = "bottom", keywidth = 6
    )
  )