rggplot2facet-wrapggdist

Facet legend for multiple geoms in ggplot2 with new color scales in each facet

I am trying to replicate a figure from this post (How to group a legend or get seperate legends by facets in ggplot2). I am trying to modify this figure to include stat_pointinterval from the ggdist package along with a geom_density rather than a geom_bar. The geom_density works fine, but I can't get the stat_interval to group legend items by facet the same way that geom_density does. So far, the code below is the best I've been able to achieve, but I would like the stat_intervals to match the color of their respective densities. The actual data I've been trying to apply this to has many groups, and the number of groups in each facet is inconsistent, so I have not been usual a manual color scale, and I have changed the y axis scale, but otherwise, the code is almost the same as the original example.

library(ggplot2)
library(ggdist)

sub_region_colours <- c("South America" = "#0570b0", "Western Africa" = "#8c96c6", "Central America" = "#74a9cf", "Eastern Africa" = "#8856a7", "Northern Africa" = "#edf8fb", "Middle Africa" = "#b3cde3", "Southern Africa" = "#810f7c", "Northern America" = "#f1eef6", "Caribbean" = "#bdc9e1", "Eastern Asia" = "#bd0026", "Southern Asia" = "#fd8d3c", "South-Eastern Asia" = "#f03b20", "Southern Europe" = "#238b45", "Australia and New Zealand" = "#ce1256", "Melanesia" = "#df65b0", "Micronesia" = "#d7b5d8", "Polynesia" = "#f1eef6", "Central Asia" = "#fecc5c", "Western Asia" = "#ffffb2", "Eastern Europe" = "#66c2a4", "Northern Europe" = "#edf8fb", "Western Europe" = "#b2e2e2", "Small Islands" = "#252525")

d <- structure(list(sender_iso3 = c(
  "ABW", "ABW", "ABW", "ABW", "ABW",
  "ABW", "ABW", "ABW", "ABW", "ABW", "ABW", "ABW"
), year = c(
  2005,
  2011, 2014, 2015, 2016, 2017, 2005, 2011, 2014, 2015, 2016, 2017
), sender_region = c(
  "Americas", "Americas", "Americas", "Americas",
  "Americas", "Americas", "Africa", "Africa", "Africa", "Africa",
  "Africa", "Africa"
), sender_subregion = c(
  "Caribbean", "Caribbean",
  "Caribbean", "Caribbean", "South America", "South America", "Southern Africa",
  "Southern Africa", "Southern Africa", "Southern Africa", "Eastern Africa",
  "Eastern Africa"
), export = c(
  1, 1, 4, 5, 2, 1, 1, 1, 4, 5,
  2, 1
)), class = "data.frame", row.names = c(NA, -12L))
regions <- unique(d$sender_region)

# Layers for each region
make_layers <- function(x) {
  d <- filter(d, sender_region == regions[[x]])
  
  list(
    if (x != 1) new_scale_fill(),
    geom_density(data = d, aes(x = year, fill = sender_subregion), alpha = .5, color = NA),
# Below is the problem line:
    stat_pointinterval(data = d, aes(x = year, fill = sender_subregion, color = sender_subregion)),
    ylim(0,1),
    scale_fill_discrete(
      guide = guide_legend(
        order = x,
        title = regions[x],
        title.position = "top"
      )
    )
  )
}
p <- ggplot() +
  lapply(seq_along(regions), make_layers)

# Add theme and wrap
p +
  theme_minimal() +
  scale_x_continuous(
    name = "Year", limits = c(1986, 2017),
    breaks = c(1986, 1990, 2000, 2010, 2017),
    guide = guide_axis(angle = 90)
  ) +
  facet_wrap(~sender_region)
Solution

  • In contrast to the code in the post you referenced you have both a fill and a color scale. Hence, you have to adapt the code to also add a new color scale using new_scale_color() and scale_color_xxx. However, as far you want to apply the same colors the latter can be omitted by applying the fill scale to both color and fill using aesthetics = c("fill", "color"). Additionally I switched to scale_fill_manual to apply your custom colors.

    library(ggplot2)
library(ggdist)
library(dplyr, warn = FALSE)
library(ggnewscale)

# Layers for each region
make_layers <- function(x) {
  d <- filter(d, sender_region == regions[[x]])

  list(
    if (x != 1) new_scale_fill(),
    if (x != 1) new_scale_color(),
    geom_density(data = d, aes(x = year, fill = sender_subregion), alpha = .5, color = NA),
    # Below is the problem line:
    stat_pointinterval(data = d, aes(x = year, color = sender_subregion)),
    ylim(0, 1),
    scale_fill_manual(
      values = sub_region_colours,
      guide = guide_legend(
        order = x,
        title = regions[x],
        title.position = "top"
      ),
      aesthetics = c("fill", "color")
    )
  )
}
p <- ggplot() +
  lapply(seq_along(regions), make_layers)
#> Scale for y is already present.
#> Adding another scale for y, which will replace the existing scale.

# Add theme and wrap
p +
  theme_minimal() +
  scale_x_continuous(
    name = "Year", limits = c(1986, 2017),
    breaks = c(1986, 1990, 2000, 2010, 2017),
    guide = guide_axis(angle = 90)
  ) +
  facet_wrap(~sender_region)