Add secondary headings to facet_wraps

Question

I have a data frame consisting of eight sites (i.e., A,B,C...H) spread across two locations (i.e., North and South). I have made a figure for each site using facet_wrap() however, I would like to add an additional column heading denoting the site's location. How can I do this?

Example Data

library(ggplot2)
library(dplyr)

set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df

Example Figure (missing the secondary header)

df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_wrap(~site, nrow = 2)

Here is a similar SO question (link here) however, I could not get it to work when there is already a scale_x_continuous() function called and it was not clear how that answer would work with multiple headings on the same axis.

Here is an example of the output I am looking for. Note the df$location is the secondary x-axis header and that the left two columns are North sites while the right two columns are South sites.

score 5 · Answer 1 · answered Jan 05 '23 at 20:50

5

Building on akrun's answer, you can hide a strip by setting the corresponding elements to blank in strip_nested(). I haven't figured out a way to remove the redundant space though.

library(ggh4x)
#> Loading required package: ggplot2
library(ggplot2)
library(dplyr)


set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_manual(
    vars(location, site), design = "ABEF\nCDGH",
    strip = strip_nested(
      text_x = list(element_text(), element_blank())[c(1,1,2,2,rep(1, 8))],
      background_x = list(element_rect(), element_blank())[c(1,1,2,2,rep(1, 8))]
    ))

^{Created on 2023-01-05 by the reprex package (v2.0.1)}

answered Jan 05 '23 at 20:50

teunbrand

33,645
4
37
63

1

I was about to post something similar, except the location headers were styled as per the question. Required more code though, so I will leave this one to the maestro! – Allan Cameron Jan 05 '23 at 21:03
@teunbrand if you do come across a method for removing the redundant white space between the top and bottom row please share. Myself and others would like to know. – tassones Jan 05 '23 at 21:26
@AllanCameron I am interested to know how you were planning to go about styling the secondary headers. – tassones Jan 05 '23 at 21:27
@tassones well it is probably a bug, which should get fixed – teunbrand Jan 05 '23 at 21:37
The redundant space can be removed with a negative panel spacing - see my example. – Allan Cameron Jan 05 '23 at 21:38
Hah, smart trick! Still should probably be fixed though. – teunbrand Jan 05 '23 at 21:40

Allan Cameron · Accepted Answer · 2023-01-05T22:26:46.033

To style each subheader as you please, you could do something like:

library(ggh4x)

# Create blank headers for a dummy variable that we will use for rows
outer_rect <- list(element_blank(), element_blank())
outer_text <- list(element_blank(), element_blank())

# Create black headers for first row of location strips, blank otherwise
loc_rect <- list(element_rect(fill = "black"), element_rect(fill = "black"),
                 element_blank(), element_blank())
loc_text <- list(element_text(colour = "white", size = 14),
                 element_text(colour = "white", size = 14),
                 element_blank(), element_blank())

# Create 8 normal strips for the letter headers
final_rect <- elem_list_rect(fill = rep("gray", 8))
final_text <- elem_list_text(colour = rep("black", 8))

Now we create a dummy variable to give the letters the appropriate facet rows.

df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  # This generates a dummy variable (1 for first row, 2 for second row)
  mutate(rownum = site %in%  c('C','D','G','H') + 1) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_nested_wrap(rownum~location + site, nrow = 2,
                    strip = strip_nested(
                      background_x = c(outer_rect, loc_rect, final_rect),
                      text_x = c(outer_text, loc_text, final_text)
                    )) +
  theme(panel.spacing.y = unit(-10, "mm"))

this is great but a little hard to digest what the code is doing. Could you annotate it? Particularly what the ```..._rect```, ```..._text```, and ```mutate(rowsum =...)```. I am trying to adapt this to a plot with three rows and am having trouble (in hindsight, I should have made my example with three rows). — tassones, Jan 05 '23 at 22:17
Just in case anyone comes across this page in the future...if you have three rows for example (i.e., 12 plots total), you will need to add an extra ```element_blank()``` to ```outer_rect``` and ```outer_text```. Then add 2 extra ```element_blank()``` to ```loc_treat``` and ```loc_text```. Lastly, change the 8 nominal strips to 12. Also, make sure your ```rowsum``` is 1 for first row sites, 2 for second, and 3 for third. — tassones, Jan 05 '23 at 23:08

Add secondary headings to facet_wraps

2 Answers2