rsortingggplot2legendggpattern

Custom sort order on dynamic legend items for ggpattern and ggplot items


I'm trying to sort legend entries across both ggplot and ggpattern items. The map will not always include all the layers, so the legend should be dynamic - only showing legend items for those layers that have data. I have tried setting guides to overwrite the default layer order and putting in a dummy layer, but cannot seem to get it right. Is anyone able to help out?

Here is my code:

eo_map <- st_read("link to shapefile")

# create dataframes for each season so we can layer on the map
y <- subset(eo_map, SeasonCode == "Year-round")
b <- subset(eo_map, SeasonCode == "Breeding")
m <- subset(eo_map, SeasonCode == "Migrating")
w <- subset(eo_map, SeasonCode == "Wintering")
h <- subset(eo_map, SeasonCode == "Historic")

# create the plot/map with county basemap
a <- ggplot() +
  geom_sf(data = county_sf, fill = NA, color = "black") +
  theme_void() +
  theme(legend.position = "bottom")

# Add layers dynamically if records exist
if (nrow(h) > 0) {
  a <- a +
    geom_sf(
      data = h,
      aes(fill = "Historic"),
      alpha = 1.0,
      color = "black"
    )
}
if (nrow(y) > 0) {
  a <- a +
    geom_sf(
      data = y,
      aes(fill = "Year-round"),
      alpha = 1.0,
      color = "black"
    )
}
if (nrow(b) > 0) {
  a <- a +
    geom_sf(
      data = b,
      aes(fill = "Breeding"),
      alpha = 0.8,
      color = "black"
    )
}
if (nrow(m) > 0) {
  a <- a +
    geom_sf_pattern(
      data = m,
      aes(pattern_fill = "Migratory"),
      pattern_colour = "#515150",
      pattern_density = 0.001,
      pattern_spacing = 0.02,
      pattern_angle = 135,
      fill = "transparent",
      color = "black"
    )
}
if (nrow(w) > 0) {
  a <- a +
    geom_sf_pattern(
      data = w,
      aes(pattern_fill = "Wintering"),
      pattern_colour = "#515150",
      pattern_density = 0.001,
      pattern_spacing = 0.02,
      pattern_angle = 45,
      fill = "transparent",
      color = "black"
    )
}
# Dynamically configure the legend
legend_values_fill <- c(
  if (nrow(y) > 0) "Year-round" = "#5F9DA1",
  if (nrow(b) > 0) "Breeding" = "#E6B23B",
  if (nrow(h) > 0) "Historic" = "#ACA692"
)

legend_values_pattern_fill <- c(
  if (nrow(m) > 0) "Migratory" = "#515150",
  if (nrow(w) > 0) "Wintering" = "#515150"
)

# Apply scales if values exist
if (length(legend_values_fill) > 0) {
  a <- a +
    scale_fill_manual(values = legend_values_fill, name = NULL)
}
if (length(legend_values_pattern_fill) > 0) {
  a <- a +
    scale_pattern_fill_manual(values = legend_values_pattern_fill, name = NULL)
}

a

Here is the map that it produces, which is fine, but I'd like for the legend to always show in a specific order if layers are present ("Year-round", "Breeding", "Migratory", "Wintering", "Historic"):

enter image description here

Sample shapefile can be downloaded from my Google Drive


Solution

  • The issue is that you have two separate legends, i.e. one for fill and one for pattern_fill and you can't mix the legend keys for both. Instead, to achieve your desired result the first step is to have just one legend which could be achieved by using geom_sf_pattern for all of your layers and by mapping SeasonCode to both the fill and the pattern_fill aes. Second step, convert SeasonCode to a factor with your desired order.

    Additionally I refactored your code to dynamically add the layers via a helper function and using split and Map.

    Using a minimal reproducible example based on the default example from ?geom_sf:

    library(ggplot2)
    library(ggpattern)
    
    ### example data
    set.seed(123)
    
    county_sf <- eo_map <- sf::st_read(system.file("shape/nc.shp", package = "sf"), quiet = TRUE)
    
    eo_map$SeasonCode <- sample(
      c("Historic", "Breeding", "Migrating", "Wintering"),
      nrow(eo_map),
      replace = TRUE
    )
    ###
    
    # Convert to a factor with the desired order
    eo_map$SeasonCode <- factor(
      eo_map$SeasonCode,
      c("Year-round", "Breeding", "Migrating", "Wintering", "Historic")
    )
    # Split by Season
    eo_map_split <- split(eo_map, ~SeasonCode)
    
    # Base map
    a <- ggplot() +
      geom_sf(data = county_sf, fill = NA, color = "black") +
      theme_void() +
      theme(legend.position = "bottom")
    
    # Helper function to add the layers
    add_layers <- function(.data, .fill) {
      pattern <- if (.fill %in% c("Migrating", "Wintering")) {
        "stripe"
      } else {
        "none"
      }
      geom_sf_pattern(
        data = .data,
        aes(pattern_fill = SeasonCode, fill = SeasonCode),
        pattern_colour = "#515150",
        pattern_density = 0.001,
        pattern_spacing = 0.02,
        pattern_angle = 135,
        pattern = pattern,
        color = "black"
      )
    }
    
    # Add the season layers
    b <- a +
      Map(
        add_layers, eo_map_split, names(eo_map_split)
      ) 
    
    b +
      scale_fill_manual(
        values = c(
          "Year-round" = "#5F9DA1",
          "Breeding" = "#E6B23B",
          "Historic" = "#ACA692",
          "Migrating" = "transparent",
          "Wintering" = "transparent"
        ),
        labels = ~ ifelse(.x == "Migrating", "Migratory", .x),
        name = NULL
      ) +
      scale_pattern_fill_manual(
        values = c(
          "Year-round" = "transparent",
          "Breeding" = "transparent",
          "Historic" = "transparent",
          "Migrating" = "#515150",
          "Wintering" = "#515150"
        ),
        labels = ~ ifelse(.x == "Migrating", "Migratory", .x),
        name = NULL
      )
    

    enter image description here