2

I'm using ggplot() and geom_sf() to plot a faceted map (s. below code) and color units along a scale_fill_gradient() by a variable (value in the example below), before faceting by another variable (group). This works; but now I would like to change the color at the gradient's higher end (not midpoint or lower) depending on the facet. Based on this answer, I have saved this in a separate column (color_high) in the plotting data frame. However, I cannot get it to translate into the plotting scale.

Can someone point me to the right direction? Below is the working code with a single fill gradient. The expected output has high values as defined in color_high (red in Group A, green in Group B).

library(sf)
library(tidyverse)
theme_set(theme_bw())
library(giscoR)

ger_fedstates <- gisco_get_nuts(nuts_level = 1, resolution = 10, country = "Germany", year = 2021)

dat <- read.table(text = "state value group
                          Sachsen 10 a
                          Sachsen 1 b
                          Bayern 3 a
                          Bayern 30 b
                          Rheinland-Pfalz 50 a
                          Rheinland-Pfalz 50 b
                          Saarland 70 a
                          Saarland 70 b
                          Schleswig-Holstein 9 a
                          Schleswig-Holstein 90 b
                          Niedersachsen  100 a
                          Niedersachsen  100 b
                          Nordrhein-Westfalen 80 a
                          Nordrhein-Westfalen 80 b
                          Baden-Württemberg 60 a
                          Baden-Württemberg 60 b
                          Brandenburg 40 a
                          Brandenburg 40 b
                          Mecklenburg-Vorpommern 20 a
                          Mecklenburg-Vorpommern 20 b
                          Bremen 40 a
                          Bremen 40 b
                          Hamburg 60 a
                          Hamburg 60 b
                          Hessen 15 a
                          Hessen 15 b
                          Berlin 10 a
                          Berlin 10 b
                          Thüringen 80 a
                          Thüringen 80 b
                          Sachsen-Anhalt 20 a
                          Sachsen-Anhalt 20 b", header = T) %>% 
  mutate(color_high = case_when(group=="a"~"red", group=="b"~"green"))

plot_df <- full_join(ger_fedstates, dat, by=c("NUTS_NAME" = "state"))

plot_df %>% 
  ggplot() +
  geom_sf(aes(fill = value)) +
  theme(axis.text.x = element_blank(),
        axis.text.y = element_blank(),
        axis.line.x = element_blank(),
        axis.line.y = element_blank(),
        legend.position = "right",
        legend.title.align = 0) +
  scale_fill_gradient2(low = "grey40",
                       mid = "white",
                       high = "#0000ff", # this should be the value of "color_high" column
                       midpoint=50,
                       guide = "colourbar",
                       aesthetics = "fill") + 
  facet_wrap(~group, labeller = labeller(group=c(a="Group A", b="Group B", c="Group C")))
Ivo
  • 3,890
  • 5
  • 22
  • 53

2 Answers2

3

I don't think it's possible to have different scales for each facet but you could make a loop to create one plot per group and then use patchwork to put them together (it becomes annoying if you have many groups though):

library(sf)
#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(tidyverse)
theme_set(theme_bw())
library(giscoR)
library(patchwork)

ger_fedstates <- gisco_get_nuts(nuts_level = 1, resolution = 10, country = "Germany", year = 2021)

dat <- read.table(text = "state value group
                        Sachsen 10 a
                        Sachsen 1 b
                        Bayern 3 a
                        Bayern 30 b
                        Rheinland-Pfalz 50 a
                        Rheinland-Pfalz 50 b
                        Saarland 70 a
                        Saarland 70 b
                        Schleswig-Holstein 9 a
                        Schleswig-Holstein 90 b
                        Niedersachsen  100 a
                        Niedersachsen  100 b
                        Nordrhein-Westfalen 80 a
                        Nordrhein-Westfalen 80 b
                        Baden-Württemberg 60 a
                        Baden-Württemberg 60 b
                        Brandenburg 40 a
                        Brandenburg 40 b
                        Mecklenburg-Vorpommern 20 a
                        Mecklenburg-Vorpommern 20 b
                        Bremen 40 a
                        Bremen 40 b
                        Hamburg 60 a
                        Hamburg 60 b
                        Hessen 15 a
                        Hessen 15 b
                        Berlin 10 a
                        Berlin 10 b
                        Thüringen 80 a
                        Thüringen 80 b
                        Sachsen-Anhalt 20 a
                        Sachsen-Anhalt 20 b", header = T) %>% 
  mutate(color_high = case_when(group=="a"~"red", group=="b"~"green"))


plot_df <- full_join(ger_fedstates, dat, by=c("NUTS_NAME" = "state"))
#> Warning in sf_column %in% names(g): Each row in `x` is expected to match at most 1 row in `y`.
#> ℹ Row 1 of `x` matches multiple rows.
#> ℹ If multiple matches are expected, set `multiple = "all"` to silence this
#>   warning.

plots <- list()
for (i in unique(plot_df$group)) {
  tmp <- plot_df %>% 
    filter(group == i)
  
  high_color <- ifelse(unique(tmp$group) == "a", "red", "green")
  
  plots[[i]] <- tmp %>%
    ggplot() +
    geom_sf(aes(fill = value)) +
    theme(axis.text.x = element_blank(),
          axis.text.y = element_blank(),
          axis.line.x = element_blank(),
          axis.line.y = element_blank(),
          legend.position = "right",
          legend.title.align = 0) +
    scale_fill_gradient2(
      low = "grey40",
      mid = "white",
      high = high_color, # this should be the value of "color_high" column
      midpoint=50,
      guide = "colourbar",
      aesthetics = "fill"
    ) +
    labs(title = paste0("Group ", i))
}


purrr::reduce(plots, `+`)
# can also use wrap_plots(plots)

bretauv
  • 7,756
  • 2
  • 20
  • 57
0

Building on bretauv's answer (great approach), I personally prefer to loop over proper lists - as you have groups in your data frame, you can create this list with split or with dplyr::group_split (which does not give a named list, but you don't need it here). Having more than two groups is not a big problem if you use a named lookup vector instead for easy assignment of colors to your groups. I have slightly modified the example, but I hope the gist becomes clear. Other comments in the code.

library(ggplot2)
library(patchwork)
library(dplyr)

dat <- 
  dat %>%
  ## random example
  arrange(group) %>%
  mutate(x = rep(1:4, 8), y = rep(rep(1:4, each = 4), 2))

## make a lookup for your data so that makes color high easy
cols <- setNames(c("darkred", "darkgreen"), letters[1:2] )

## color_high and split groups
dat_split <- 
  dat %>%
  ## this is using the look up vector
  mutate(color_high = cols[group]) %>%
## splitting by group 
  group_split(group)

purrr::map(dat_split, ~{
  ggplot(.x, aes(x, y)) +
  geom_tile(aes(fill = value)) +
  geom_text(aes(label = substr(state, 1,5))) +
    ## you need to pass the unique group and color identifier to your scale
  scale_fill_gradient2(unique(.x$group), 
                       low = "grey40",
                       mid = "white",
                       high = unique(.x$color_high), 
                       midpoint=50,
                       guide = "colourbar",
                       aesthetics = "fill") +
    facet_grid(~group)
}) %>%
  ## wrap the plots 
  wrap_plots() +
  plot_layout(guides = "collect")

tjebo
  • 21,977
  • 7
  • 58
  • 94