Create labeller to select which strip texts are displayed using facet_manual

Question

I have the following plot:

Sample code:

dat = data.frame(grp = rep(c("Group1", "Group2"), 24),
                 label = rep(c(rep("Yes",2), rep("Rather yes",2), rep("Rather no",2), rep("No",2)), 6),
                 pct = rep(c(25,25,25,25), 12),
                 grp2 = c(rep("Total", 8),rep("Age", 24),rep("Gender", 16)),
                 label2 = c(rep("",8), rep("18-29", 8),rep("30-64", 8),rep("65-80", 8),rep("Male", 8),rep("Female", 8))) 

dat$grp2 <- factor(dat$grp2, levels = c("Total", "Gender", "Age"))

# Design for facet_manual (ggh4x-Package)
design <- matrix(1:6,3)
heights <- c(8,16,24)

# Plot
plot <- ggplot2::ggplot(data = dat, ggplot2::aes(x = pct, y = label2, fill = label)) +
  ggplot2::geom_bar(stat = 'identity', position = 'stack', width = 0.8, color = 'white') + 
  ggh4x::facet_manual(grp~grp2, design = design, heights = heights, scales = "free_y", strip.position = "top");plot

I would like very much that Group1 or Group2 is written only once, at the top of the plot. One possibility I found is to select what is shown using labeller. But I do not understand the structure of the underlying labeller object (in the example only the inner label is shown, not as I want 1x outer label at the top and all inner labels).

plot <- ggplot2::ggplot(data = dat, ggplot2::aes(x = pct, y = label2, fill = label)) +
  ggplot2::geom_bar(stat = 'identity', position = 'stack', width = 0.8, color = 'white') + 
  ggh4x::facet_manual(grp~grp2, design = design, heights = heights, scales = "free_y", strip.position = "top", 
                      labeller = function(df) {list(as.character(df[,2]))});plot

Does anyone have a solution? Of course it would also be possible to create two plots and then attach them next to each other. But I would be interested in a solution that generates a plot directly with facets.

I already tried using different labeller functions as well as using facet_nested_wrap as an Alternative.

Answer 1

Using the inputs defined in the question define a labeller function which accepts a data frame whose columns names will be grp and grp2 and whose 6 rows are the levels of each of the 6 facets. Replace those with the names that should be shown so that in this case if grp2 is Total then use the grp name for grp and otherwise use "" for grp.

To be specific this data frame will be passed to the labeller function:

     grp   grp2
1 Group1  Total
2 Group1 Gender
3 Group1    Age
4 Group2  Total
5 Group2 Gender
6 Group2    Age

and the labeller function will return this data frame:

     grp   grp2
1 Group1  Total
2        Gender
3           Age
4 Group2  Total
5        Gender
6           Age

The code follows.

library(ggplot2)
library(ggh4x)

label_fun <- function(data) {
  transform(data, grp = ifelse(grp2 == "Total", grp, ""),
                  grp2 = as.character(grp2))
}

plot <- ggplot(data = dat, aes(x = pct, y = label2, fill = label)) +
 geom_bar(stat = 'identity', position = 'stack', width = 0.8, color = 'white') + 
 facet_manual(~ grp + grp2, design = design, heights = heights, scales = "free_y",
   strip.position = "top", labeller = label_fun)
plot

Added

Another approach is to collapse grp and grp2 into a single factor grps.

label_fun2 <- function(x) {
  transform(x, grps = ifelse(grepl("Total", grps), 
                             sub("\\.", " - ", grps),
                             sub("\\..*", "", grps)))
} 

levs <- c("Total.Group1", "Gender.Group1", "Age.Group1",
          "Total.Group2", "Gender.Group2", "Age.Group2")
dat |>
  transform(grps = factor(interaction(grp2, grp), levs)) |>
  ggplot(aes(x = pct, y = label2, fill = label)) +
    geom_bar(stat = 'identity', position = 'stack', width = 0.8, color = 'white') +
    facet_manual(~ grps , design = design, heights = heights, scales = "free_y",
    strip.position = "top", labeller = label_fun2)

or if we use this labeller function which uses \n in place of - with the same ggplot2 code

label_fun2 <- function(x) {
  transform(x, grps = ifelse(grepl("Total", grps), 
                             sub("\\.", " \n ", grps),
                             sub("\\..*", "", grps)))
} 

Note that levs, above, could be computed using:

dat |>
  with(expand.grid(grp2 = levels(grp2), grp = levels(factor(grp)))) |>
  with(interaction(grp2, grp))

Yet another approach is to use facet_grid2:

ggplot(dat, aes(x = pct, y = label2, fill = label)) +
  geom_bar(stat = 'identity', position = 'stack', width = 0.8, color = 'white') +
  facet_grid2(grp2 ~ grp, scales = "free_y", switch = "y")