ggplot2 中多个几何图形的面图例，每个面都有新的色标

Question

我正在尝试复制这篇文章中的一个图形（如何对图例进行分组或通过 ggplot2 中的面获取单独的图例）。我正在尝试修改此图以包含

stat_pointinterval

包中的

ggdist

以及

geom_density

而不是

geom_bar

。

geom_density

工作正常，但我无法让

stat_interval

以与

geom_density

相同的方式按面对图例项目进行分组。到目前为止，下面的代码是我能够实现的最好的代码，但我希望

stat_intervals

能够匹配它们各自密度的颜色。我一直试图将其应用到的实际数据有很多组，并且每个方面的组数不一致，所以我没有通常使用手动颜色比例，并且我更改了y轴比例，但除此之外，代码与原始示例几乎相同。

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)

Answer 1

与您引用的帖子中的代码相反，您有一个

fill

和

color

刻度。因此，您必须调整代码以使用

new_scale_color()

和

scale_color_xxx

添加新的色标。但是，如果您想应用相同的颜色，可以通过使用

color

将填充比例应用于

fill

和

aesthetics = c("fill", "color")

来省略后者。此外，我切换到

scale_fill_manual

以应用您的自定义颜色。

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)