rggplot2visualizationfacetggh4x

How to implement conditional coloring for facet nested panels in R


I would like to apply color to the panels based on certain conditions. In the provided example picture, a fixed color is manually specified. Instead of this fixed color, is it possible to implement an IF-ELSE structure for conditional coloring? Below is the code I wrote, but it doesn't seem to work. Any ideas from anyone would be appreciated. Thanks

strip_background <- strip_themed(
  text_x = elem_list_text(colour = "white", face = 'bold'),
  background_x = elem_list_rect(fill = ifelse(levels(level3_long$cluster) == "1", "green",
                                              ifelse(levels(level3_long$cluster) == "2", "red", "blue")))
)

ggplot(level3_long, aes(x= values, y = Ages,fill = (cluster))) +
  geom_areah(aes(size=10), linetype = 1) +
  geom_areah_exaggerate(exaggerate_x = 15, alpha = 0.2)+
  scale_y_reverse(name = "age", breaks = seq(0, max(level3_long$Ages), by = 2000)) +
  scale_fill_manual(values = color_palette) + 
  facet_nested(~ level_2 + level_3, scales = "free_x",strip = strip_background) +
  scale_x_continuous(breaks = scales::pretty_breaks(n = 3))+
  theme_bw() + 
  theme(axis.title = element_text(size = 13),
        strip.text.x = element_text(size = 17, angle = 90, hjust = 0, vjust = 0.05),
        axis.text.x = element_text(size = 11, angle = 90), # Adjusted x-axis label size
        axis.text.y = element_text(size = 13, vjust = 0.05, face = "bold"),
        plot.margin = margin(1, 1, 1, 2, "cm"), # Adjusted plot.margin
        panel.spacing = unit(0.5, "lines"),
        panel.border = element_rect(fill = NA, colour = "black"),
        legend.position="bottom",
        legend.title = element_text(size=10),
        legend.text = element_text(size=13),
        plot.title = element_text(size = 18, hjust = 0.05, face = "bold") # Adjust title size and alignment
  ) + guides(size= "none")

example from ggh4x tutorial


Solution

  • Your description of what is not working, aka it doesn't seem to work is rather vague. But there are two issues. First, you should use strip_nested with facet_nested. Second, you are creating a vector of colors based on a column from your data which is not in related to the number and combinations of facets. Instead the length of this vector equals the number of rows in your data and from this vector colors are picked in order to fill the strips.

    Instead, if you want to get the right assignments then create a separate dataframe containing the combinations of the facetting variables and your cluster assignments. The columns of this dataframe can then be used to create the vector of fill colors for the nested facet where I use dplyr::case_match instead of a nested ifelse.

    Using a minimal reproducible example based on the ggplot2::mpg dataset:

    library(ggplot2)
    library(ggh4x)
    library(dplyr, warn = FALSE)
    
    km <- mpg |>
      select(drv, year) |>
      mutate(across(everything(), ~ as.numeric(factor(.x)))) |>
      scale() |>
      kmeans(centers = 3)
    
    mpg2 <- mpg |>
      bind_cols(cluster = km$cluster)
    
    # Combinations of facetting variables including cluster assignment
    combos <- mpg2 |>
      distinct(drv, year, cluster) |>
      arrange(drv, year)
    
    strip_background <- strip_nested(
      text_x = elem_list_text(colour = "white", face = "bold"),
      background_x =
        elem_list_rect(
          fill = c(
            # level1 colors
            case_match(
              unique(combos$drv),
              "f" ~ "purple",
              "4" ~ "orange",
              .default = "grey"
            ),
            # level2 colors
            case_match(
              combos$cluster,
              1 ~ "green",
              2 ~ "red",
              .default = "blue"
            )
          )
        )
    )
    
    ggplot(mpg, aes(displ, hwy, colour = as.factor(cyl))) +
      geom_point() +
      labs(x = "Engine displacement", y = "Highway miles per gallon") +
      guides(colour = "none") +
      facet_nested(
        ~ drv + year,
        scales = "free_x",
        strip = strip_background
      )