Three level x-axis labels for stacked bar chart

I’m going to need the help of the entire Applied Epi Cinematic Universe for this one!

I have an Excel graph that I am trying to reproduce in R. Here is the original:

Notice that there are three levels in the x-axis - quarters_combined, fiscal_year and total_hospital_region.

I cannot seem to make the x-axis in the same way. Here is my latest attempt:

I have two issues:

1) How do I recreate the x-axis labels in the same way? I need the total_hospital_region to be grouped instead of repeated and the order of the levels to the same.
2) How do I get the bar width to be the same in all the bars? Notice that when there is only β€œQ1/Q2”, the bar width doubles to equal the same as both β€œQ1/Q2” and β€œQ3/Q4”.

Here is my reproducible code for what I have done so far:

data_grouped <- tibble::tribble(
   ~total_hospital_region, ~fiscal_year, ~quarters_combined, ~outcome_detail,  ~n,
                "TORONTO",      "21/22",            "Q1/Q2",                 "A", 39L,
                "TORONTO",      "21/22",            "Q1/Q2",                 "B", 19L,
                "TORONTO",      "21/22",            "Q3/Q4",                 "A", 51L,
                "TORONTO",      "21/22",            "Q3/Q4",                 "B", 34L,
                "TORONTO",      "22/23",            "Q1/Q2",                 "A", 48L,
                "TORONTO",      "22/23",            "Q1/Q2",                 "B", 29L,
                "TORONTO",      "22/23",            "Q3/Q4",                 "A", 44L,
                "TORONTO",      "22/23",            "Q3/Q4",                 "B", 21L,
                "TORONTO",      "23/24",            "Q1/Q2",                 "A", 43L,
                "TORONTO",      "23/24",            "Q1/Q2",                 "B", 26L,
                 "LONDON",      "21/22",            "Q1/Q2",                 "A", 19L,
                 "LONDON",      "21/22",            "Q1/Q2",                 "B", 13L,
                 "LONDON",      "21/22",            "Q3/Q4",                 "A", 21L,
                 "LONDON",      "21/22",            "Q3/Q4",                 "B", 12L,
                 "LONDON",      "22/23",            "Q1/Q2",                 "A", 18L,
                 "LONDON",      "22/23",            "Q1/Q2",                 "B", 14L,
                 "LONDON",      "22/23",            "Q3/Q4",                 "A", 22L,
                 "LONDON",      "22/23",            "Q3/Q4",                 "B", 11L,
                 "LONDON",      "23/24",            "Q1/Q2",                 "A", 16L,
                 "LONDON",      "23/24",            "Q1/Q2",                 "B", 18L,
               "HAMILTON",      "21/22",            "Q1/Q2",                 "A", 16L,
               "HAMILTON",      "21/22",            "Q1/Q2",                 "B",  8L,
               "HAMILTON",      "21/22",            "Q3/Q4",                 "A", 17L,
               "HAMILTON",      "21/22",            "Q3/Q4",                 "B", 13L,
               "HAMILTON",      "22/23",            "Q1/Q2",                 "A", 23L,
               "HAMILTON",      "22/23",            "Q1/Q2",                 "B", 10L,
               "HAMILTON",      "22/23",            "Q3/Q4",                 "A", 24L,
               "HAMILTON",      "22/23",            "Q3/Q4",                 "B",  9L,
               "HAMILTON",      "23/24",            "Q1/Q2",                 "A", 16L,
               "HAMILTON",      "23/24",            "Q1/Q2",                 "B",  8L,
                 "OTTAWA",      "21/22",            "Q1/Q2",                 "A", 10L,
                 "OTTAWA",      "21/22",            "Q1/Q2",                 "B",  5L,
                 "OTTAWA",      "21/22",            "Q3/Q4",                 "A",  9L,
                 "OTTAWA",      "21/22",            "Q3/Q4",                 "B",  4L,
                 "OTTAWA",      "22/23",            "Q1/Q2",                 "A",  9L,
                 "OTTAWA",      "22/23",            "Q1/Q2",                 "B",  6L,
                 "OTTAWA",      "22/23",            "Q3/Q4",                 "A",  9L,
                 "OTTAWA",      "22/23",            "Q3/Q4",                 "B", 10L,
                 "OTTAWA",      "23/24",            "Q1/Q2",                 "A",  9L,
                 "OTTAWA",      "23/24",            "Q1/Q2",                 "B", 12L,
               "KINGSTON",      "21/22",            "Q1/Q2",                 "A",  5L,
               "KINGSTON",      "21/22",            "Q1/Q2",                 "B",  1L,
               "KINGSTON",      "21/22",            "Q3/Q4",                 "A",  2L,
               "KINGSTON",      "21/22",            "Q3/Q4",                 "B",  3L,
               "KINGSTON",      "22/23",            "Q1/Q2",                 "A", 10L,
               "KINGSTON",      "22/23",            "Q3/Q4",                 "A",  2L,
               "KINGSTON",      "22/23",            "Q3/Q4",                 "B",  2L,
               "KINGSTON",      "23/24",            "Q1/Q2",                 "A",  7L,
               "KINGSTON",      "23/24",            "Q1/Q2",                 "B",  1L
   )

# install and load packages
pacman::p_load(tidyverse)

# Set color palette
colors <- c("#009DC9", "#84C7EA")

# Create the ggplot
ggplot(data_grouped, aes(x = quarters_combined, y = n, fill = outcome_detail)) +

# Stacked bar chart
geom_col(position = "stack", color = "white", width = 0.7) +

# Add data labels
geom_text(aes(label = n), position = position_stack(vjust = 0.5), size = 3) +

# Customize axes labels and title
labs(x = "", y = "") +

# Facet by total_hospital_region
facet_wrap(~total_hospital_region + fiscal_year, scales = "free_x", nrow = 1, strip.position = "bottom") +

# Customize theme if necessary
theme_minimal() +

# Customize legend
scale_fill_manual(name = "Outcome Detail", values = setNames(colors, c("B", "A"))) +

# Adjust x-axis labels
theme(axis.text.x = element_text(angle = 90, hjust = -0.5, vjust = 1),
      legend.position = "bottom",
      legend.title = element_blank()
      ) +

# Make bars all the same width
theme(panel.spacing.x = unit(0, "mm"))

Thanks in advance!

Hello,

I think the first question I would ask is whether you truly need to replicate the x-axis labels? If not, my recommendation would be to simplify things by either adjusting how the data is displayed and/or combining some of the labels.

In the event you truly do need to replicate them, I think your best bet is using facet_wrap on region as you’ve done, but then combining fiscal year and quarter into a single variable and using a custom labeller function for the usual x-axis quarterly label and then using annotate to label the fiscal year. Something like this:

# loading packages
library(tidyverse)

# creating fake data
data_grouped <- tibble::tribble(
    ~total_hospital_region, ~fiscal_year, ~quarters_combined, ~outcome_detail,  ~n,
    "TORONTO",      "21/22",            "Q1/Q2",                 "A", 39L,
    "TORONTO",      "21/22",            "Q1/Q2",                 "B", 19L,
    "TORONTO",      "21/22",            "Q3/Q4",                 "A", 51L,
    "TORONTO",      "21/22",            "Q3/Q4",                 "B", 34L,
    "TORONTO",      "22/23",            "Q1/Q2",                 "A", 48L,
    "TORONTO",      "22/23",            "Q1/Q2",                 "B", 29L,
    "TORONTO",      "22/23",            "Q3/Q4",                 "A", 44L,
    "TORONTO",      "22/23",            "Q3/Q4",                 "B", 21L,
    "TORONTO",      "23/24",            "Q1/Q2",                 "A", 43L,
    "TORONTO",      "23/24",            "Q1/Q2",                 "B", 26L,
    "LONDON",      "21/22",            "Q1/Q2",                 "A", 19L,
    "LONDON",      "21/22",            "Q1/Q2",                 "B", 13L,
    "LONDON",      "21/22",            "Q3/Q4",                 "A", 21L,
    "LONDON",      "21/22",            "Q3/Q4",                 "B", 12L,
    "LONDON",      "22/23",            "Q1/Q2",                 "A", 18L,
    "LONDON",      "22/23",            "Q1/Q2",                 "B", 14L,
    "LONDON",      "22/23",            "Q3/Q4",                 "A", 22L,
    "LONDON",      "22/23",            "Q3/Q4",                 "B", 11L,
    "LONDON",      "23/24",            "Q1/Q2",                 "A", 16L,
    "LONDON",      "23/24",            "Q1/Q2",                 "B", 18L,
    "HAMILTON",      "21/22",            "Q1/Q2",                 "A", 16L,
    "HAMILTON",      "21/22",            "Q1/Q2",                 "B",  8L,
    "HAMILTON",      "21/22",            "Q3/Q4",                 "A", 17L,
    "HAMILTON",      "21/22",            "Q3/Q4",                 "B", 13L,
    "HAMILTON",      "22/23",            "Q1/Q2",                 "A", 23L,
    "HAMILTON",      "22/23",            "Q1/Q2",                 "B", 10L,
    "HAMILTON",      "22/23",            "Q3/Q4",                 "A", 24L,
    "HAMILTON",      "22/23",            "Q3/Q4",                 "B",  9L,
    "HAMILTON",      "23/24",            "Q1/Q2",                 "A", 16L,
    "HAMILTON",      "23/24",            "Q1/Q2",                 "B",  8L,
    "OTTAWA",      "21/22",            "Q1/Q2",                 "A", 10L,
    "OTTAWA",      "21/22",            "Q1/Q2",                 "B",  5L,
    "OTTAWA",      "21/22",            "Q3/Q4",                 "A",  9L,
    "OTTAWA",      "21/22",            "Q3/Q4",                 "B",  4L,
    "OTTAWA",      "22/23",            "Q1/Q2",                 "A",  9L,
    "OTTAWA",      "22/23",            "Q1/Q2",                 "B",  6L,
    "OTTAWA",      "22/23",            "Q3/Q4",                 "A",  9L,
    "OTTAWA",      "22/23",            "Q3/Q4",                 "B", 10L,
    "OTTAWA",      "23/24",            "Q1/Q2",                 "A",  9L,
    "OTTAWA",      "23/24",            "Q1/Q2",                 "B", 12L,
    "KINGSTON",      "21/22",            "Q1/Q2",                 "A",  5L,
    "KINGSTON",      "21/22",            "Q1/Q2",                 "B",  1L,
    "KINGSTON",      "21/22",            "Q3/Q4",                 "A",  2L,
    "KINGSTON",      "21/22",            "Q3/Q4",                 "B",  3L,
    "KINGSTON",      "22/23",            "Q1/Q2",                 "A", 10L,
    "KINGSTON",      "22/23",            "Q3/Q4",                 "A",  2L,
    "KINGSTON",      "22/23",            "Q3/Q4",                 "B",  2L,
    "KINGSTON",      "23/24",            "Q1/Q2",                 "A",  7L,
    "KINGSTON",      "23/24",            "Q1/Q2",                 "B",  1L
)

# creating the plot
data_grouped |>
    mutate(comp_var = paste(fiscal_year, quarters_combined, sep = "-")) |>
    ggplot() +
    aes(x = comp_var, y = n) +
    geom_col(aes(fill = outcome_detail)) +
    annotate(geom = "text", x = 1.5, y = -2.5, label = "21/22") +
    annotate(geom = "text", x = 3.5, y = -2.5, label = "22/23") +
    annotate(geom = "text", x = 5.5, y = -2.5, label = "23/24") +
    scale_x_discrete(labels = \(x) {sapply(strsplit(x, split = "-"), "[", 2)}) +
    scale_fill_manual(values = c("A" = "#009DC9", "B" = "#84C7EA")) +
    labs(x = NULL,
             y = NULL,
             fill = NULL) +
    facet_wrap(~total_hospital_region, nrow = 1, strip.position = "bottom") +
    theme_minimal() +
    theme(legend.position = "bottom",
                axis.text.x = element_text(angle = 90, hjust = -0.5, vjust = 1))

Created on 2024-02-10 with reprex v2.0.2

Session info
sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value
#>  version  R version 4.3.1 (2023-06-16)
#>  os       macOS Ventura 13.6.3
#>  system   x86_64, darwin20
#>  ui       X11
#>  language (EN)
#>  collate  en_US.UTF-8
#>  ctype    en_US.UTF-8
#>  tz       America/Toronto
#>  date     2024-02-10
#>  pandoc   3.1.1 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package     * version date (UTC) lib source
#>  cli           3.6.2   2023-12-11 [1] CRAN (R 4.3.0)
#>  colorspace    2.1-0   2023-01-23 [1] CRAN (R 4.3.0)
#>  curl          5.2.0   2023-12-08 [1] CRAN (R 4.3.0)
#>  digest        0.6.33  2023-07-07 [1] CRAN (R 4.3.0)
#>  dplyr       * 1.1.4   2023-11-17 [1] CRAN (R 4.3.0)
#>  evaluate      0.23    2023-11-01 [1] CRAN (R 4.3.0)
#>  fansi         1.0.6   2023-12-08 [1] CRAN (R 4.3.0)
#>  farver        2.1.1   2022-07-06 [1] CRAN (R 4.3.0)
#>  fastmap       1.1.1   2023-02-24 [1] CRAN (R 4.3.0)
#>  forcats     * 1.0.0   2023-01-29 [1] CRAN (R 4.3.0)
#>  fs            1.6.3   2023-07-20 [1] CRAN (R 4.3.0)
#>  generics      0.1.3   2022-07-05 [1] CRAN (R 4.3.0)
#>  ggplot2     * 3.4.4   2023-10-12 [1] CRAN (R 4.3.0)
#>  glue          1.6.2   2022-02-24 [1] CRAN (R 4.3.0)
#>  gtable        0.3.4   2023-08-21 [1] CRAN (R 4.3.0)
#>  highr         0.10    2022-12-22 [1] CRAN (R 4.3.0)
#>  hms           1.1.3   2023-03-21 [1] CRAN (R 4.3.0)
#>  htmltools     0.5.7   2023-11-03 [1] CRAN (R 4.3.0)
#>  knitr         1.45    2023-10-30 [1] CRAN (R 4.3.0)
#>  labeling      0.4.3   2023-08-29 [1] CRAN (R 4.3.0)
#>  lifecycle     1.0.4   2023-11-07 [1] CRAN (R 4.3.0)
#>  lubridate   * 1.9.3   2023-09-27 [1] CRAN (R 4.3.0)
#>  magrittr      2.0.3   2022-03-30 [1] CRAN (R 4.3.0)
#>  munsell       0.5.0   2018-06-12 [1] CRAN (R 4.3.0)
#>  pillar        1.9.0   2023-03-22 [1] CRAN (R 4.3.0)
#>  pkgconfig     2.0.3   2019-09-22 [1] CRAN (R 4.3.0)
#>  purrr       * 1.0.2   2023-08-10 [1] CRAN (R 4.3.0)
#>  R.cache       0.16.0  2022-07-21 [1] CRAN (R 4.3.0)
#>  R.methodsS3   1.8.2   2022-06-13 [1] CRAN (R 4.3.0)
#>  R.oo          1.25.0  2022-06-12 [1] CRAN (R 4.3.0)
#>  R.utils       2.12.3  2023-11-18 [1] CRAN (R 4.3.0)
#>  R6            2.5.1   2021-08-19 [1] CRAN (R 4.3.0)
#>  readr       * 2.1.4   2023-02-10 [1] CRAN (R 4.3.0)
#>  reprex        2.0.2   2022-08-17 [1] CRAN (R 4.3.0)
#>  rlang         1.1.2   2023-11-04 [1] CRAN (R 4.3.0)
#>  rmarkdown     2.25    2023-09-18 [1] CRAN (R 4.3.0)
#>  rstudioapi    0.15.0  2023-07-07 [1] CRAN (R 4.3.0)
#>  scales        1.3.0   2023-11-28 [1] CRAN (R 4.3.0)
#>  sessioninfo   1.2.2   2021-12-06 [1] CRAN (R 4.3.0)
#>  stringi       1.8.3   2023-12-11 [1] CRAN (R 4.3.0)
#>  stringr     * 1.5.1   2023-11-14 [1] CRAN (R 4.3.0)
#>  styler        1.10.2  2023-08-29 [1] CRAN (R 4.3.0)
#>  tibble      * 3.2.1   2023-03-20 [1] CRAN (R 4.3.0)
#>  tidyr       * 1.3.0   2023-01-24 [1] CRAN (R 4.3.0)
#>  tidyselect    1.2.0   2022-10-10 [1] CRAN (R 4.3.0)
#>  tidyverse   * 2.0.0   2023-02-22 [1] CRAN (R 4.3.0)
#>  timechange    0.2.0   2023-01-11 [1] CRAN (R 4.3.0)
#>  tzdb          0.4.0   2023-05-12 [1] CRAN (R 4.3.0)
#>  utf8          1.2.4   2023-10-22 [1] CRAN (R 4.3.0)
#>  vctrs         0.6.5   2023-12-01 [1] CRAN (R 4.3.0)
#>  withr         2.5.2   2023-10-30 [1] CRAN (R 4.3.0)
#>  xfun          0.41    2023-11-01 [1] CRAN (R 4.3.0)
#>  xml2          1.3.6   2023-12-04 [1] CRAN (R 4.3.0)
#>  yaml          2.3.8   2023-12-11 [1] CRAN (R 4.3.0)
#> 
#>  [1] /Users/timothychisamore/Library/R/x86_64/4.3/library
#>  [2] /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/library
#> 
#> ──────────────────────────────────────────────────────────────────────────────

All the best,

Tim

Hi Tim,

Thanks for the speedy reply. Your answer is interesting and I like the idea of pasting the variable together. I forgot to mention that this report needs to be dynamic as this graph is produced quarterly.

I will use your idea and keep chipping away at this. I still need the quarters and the fiscal years to be close to each other - but this is one step closer. Unfortunately, I am not in a place to simplify this graph. :frowning:

Thanks for all your help!

Oren

1 Like

Hi Oren,

You could certainly make it more stable by creating a second dataset to annotate the plot with. I’m sure you can also move the various labels around further with arguments in the theme function. However, there is no simple way of producing this graph that I can think of but I did find a package that might help via nested facets: ggh4x

All the best,

Tim

Hi Tim,

All this inspiration got me down a rabbit hole of interconnected dots to come up with code below. It may not be elegant but it does feel a little closer. I used a loop through the total_hospital_region to create each plot separately then joined them together using cowplot. It’s still not perfect as I had to put a title to each plot to separate out the regions - but I probably could have done the same with a centered caption so that the region would be at the bottom.

Still, the bars are not even. Do you know how to make the bars the same width using this looping code?

Thanks again for all your help. I still need to incorporate ggh4x into this as there are valuable functionality that I use for this plot.

Here is the image of the new output:

And here is the code:

# Create a dataset grouped by region, fiscal_year and quarter so that a maximum can be used later for the y-axis
max_grouped <- data_grouped %>% 
  group_by(total_hospital_region, fiscal_year, quarters_combined) %>% 
  summarise(
    n = sum(n)
  )

# Set color palette
colors <- c("#009DC9", "#84C7EA")

# Create a list to store individual ggplots
plot_list <- list()

# Create a common legend for all plots
legend_plot <- cowplot::get_legend(ggplot(data_grouped, aes(x = quarters_combined, y = n, fill = outcome_detail)) +
  geom_col(position = "stack", color = "white", width = 1) +
  scale_fill_manual(name = "Outcome Detail", values = setNames(colors, c("B", "A"))) +
  theme_void() +
  theme(legend.position = "bottom", legend.title = element_blank()))


# Iterate over unique total_hospital_region values
for (region in unique(data_grouped$total_hospital_region)) {
  
  # Create a ggplot for the current total_hospital_region
  plot <- ggplot(data_grouped %>% filter(total_hospital_region == region),
                 aes(x = quarters_combined, y = n, fill = outcome_detail)) +
    
    # Stacked bar chart
    geom_col(position = "stack", color = "white", width = 0.5) +
    
    # Add data labels
    geom_text(aes(label = n), position = position_stack(vjust = 0.75), size = 3) +
    
    # Customize axes labels and title
    labs(x = NULL, y = NULL, title = region) +
    
    # Facet by fiscal_year
    facet_wrap(~fiscal_year, scales = "free_x", nrow = 1, strip.position = "bottom") +
    
    # Customize theme if necessary
    theme_minimal() +
    
    # Customize legend
    scale_fill_manual(name = "Outcome Detail", values = setNames(colors, c("B", "A"))) +
    
    # Create similar y-axis height
    scale_y_continuous(limits = c(0, max(max_grouped$n, na.rm = T))) +
    
    # Adjust x-axis labels
    theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5),
          legend.position = "none",
          legend.title = element_blank(),
          panel.spacing.x = unit(0, "mm"),
          strip.placement = "outside",
          plot.title.position = "plot",
          plot.title = element_text(hjust = 0.5),
          # Conditionally remove y-axis
          axis.title.y = element_blank(),  # Remove y-axis title for all regions
          axis.text.y = element_text(
            color = ifelse(region == "TORONTO", "black", "white")
                   )
    ) 
  
  # Add the current ggplot to the list
  plot_list[[region]] <- plot
  
  
}


# Combine the individual ggplots using cowplot
combined_plot <- cowplot::plot_grid(
  cowplot::plot_grid(plotlist = plot_list, align = "v", nrow = 1),
  legend_plot,
  nrow = 2, rel_heights = c(1, 0.1)
)

# Print or save the combined plot
combined_plot
1 Like

Hi Oren,

Looks like you’ve made some great progress, you should check out patchwork which is another package for combining plots! Also, you are correct about using captions instead of titles to get the regions below the x-axis.

I believe the bars are doing that because you don’t have complete data, i.e., you are missing Q3/Q4 for 23/24. The most basic solution would be to add counts of 0:

# loading packages
library(tidyverse)

# creating fake data
data_grouped <- tibble::tribble(
    ~total_hospital_region, ~fiscal_year, ~quarters_combined, ~outcome_detail,  ~n,
    "TORONTO",      "21/22",            "Q1/Q2",                 "A", 39L,
    "TORONTO",      "21/22",            "Q1/Q2",                 "B", 19L,
    "TORONTO",      "21/22",            "Q3/Q4",                 "A", 51L,
    "TORONTO",      "21/22",            "Q3/Q4",                 "B", 34L,
    "TORONTO",      "22/23",            "Q1/Q2",                 "A", 48L,
    "TORONTO",      "22/23",            "Q1/Q2",                 "B", 29L,
    "TORONTO",      "22/23",            "Q3/Q4",                 "A", 44L,
    "TORONTO",      "22/23",            "Q3/Q4",                 "B", 21L,
    "TORONTO",      "23/24",            "Q1/Q2",                 "A", 43L,
    "TORONTO",      "23/24",            "Q1/Q2",                 "B", 26L,
    "LONDON",      "21/22",            "Q1/Q2",                 "A", 19L,
    "LONDON",      "21/22",            "Q1/Q2",                 "B", 13L,
    "LONDON",      "21/22",            "Q3/Q4",                 "A", 21L,
    "LONDON",      "21/22",            "Q3/Q4",                 "B", 12L,
    "LONDON",      "22/23",            "Q1/Q2",                 "A", 18L,
    "LONDON",      "22/23",            "Q1/Q2",                 "B", 14L,
    "LONDON",      "22/23",            "Q3/Q4",                 "A", 22L,
    "LONDON",      "22/23",            "Q3/Q4",                 "B", 11L,
    "LONDON",      "23/24",            "Q1/Q2",                 "A", 16L,
    "LONDON",      "23/24",            "Q1/Q2",                 "B", 18L,
    "HAMILTON",      "21/22",            "Q1/Q2",                 "A", 16L,
    "HAMILTON",      "21/22",            "Q1/Q2",                 "B",  8L,
    "HAMILTON",      "21/22",            "Q3/Q4",                 "A", 17L,
    "HAMILTON",      "21/22",            "Q3/Q4",                 "B", 13L,
    "HAMILTON",      "22/23",            "Q1/Q2",                 "A", 23L,
    "HAMILTON",      "22/23",            "Q1/Q2",                 "B", 10L,
    "HAMILTON",      "22/23",            "Q3/Q4",                 "A", 24L,
    "HAMILTON",      "22/23",            "Q3/Q4",                 "B",  9L,
    "HAMILTON",      "23/24",            "Q1/Q2",                 "A", 16L,
    "HAMILTON",      "23/24",            "Q1/Q2",                 "B",  8L,
    "OTTAWA",      "21/22",            "Q1/Q2",                 "A", 10L,
    "OTTAWA",      "21/22",            "Q1/Q2",                 "B",  5L,
    "OTTAWA",      "21/22",            "Q3/Q4",                 "A",  9L,
    "OTTAWA",      "21/22",            "Q3/Q4",                 "B",  4L,
    "OTTAWA",      "22/23",            "Q1/Q2",                 "A",  9L,
    "OTTAWA",      "22/23",            "Q1/Q2",                 "B",  6L,
    "OTTAWA",      "22/23",            "Q3/Q4",                 "A",  9L,
    "OTTAWA",      "22/23",            "Q3/Q4",                 "B", 10L,
    "OTTAWA",      "23/24",            "Q1/Q2",                 "A",  9L,
    "OTTAWA",      "23/24",            "Q1/Q2",                 "B", 12L,
    "KINGSTON",      "21/22",            "Q1/Q2",                 "A",  5L,
    "KINGSTON",      "21/22",            "Q1/Q2",                 "B",  1L,
    "KINGSTON",      "21/22",            "Q3/Q4",                 "A",  2L,
    "KINGSTON",      "21/22",            "Q3/Q4",                 "B",  3L,
    "KINGSTON",      "22/23",            "Q1/Q2",                 "A", 10L,
    "KINGSTON",      "22/23",            "Q3/Q4",                 "A",  2L,
    "KINGSTON",      "22/23",            "Q3/Q4",                 "B",  2L,
    "KINGSTON",      "23/24",            "Q1/Q2",                 "A",  7L,
    "KINGSTON",      "23/24",            "Q1/Q2",                 "B",  1L
)

data_grouped |>
    complete(total_hospital_region = c("TORONTO", "LONDON", "HAMILTON", "OTTAWA", "KINGSTON"),
                     fiscal_year = c("21/22", "22/23", "23/24"),
                     quarters_combined = c("Q1/Q2", "Q3/Q4"),
                     outcome_detail = c("A", "B"),
                     fill = list(n = 0))
#> # A tibble: 60 Γ— 5
#>    total_hospital_region fiscal_year quarters_combined outcome_detail     n
#>    <chr>                 <chr>       <chr>             <chr>          <int>
#>  1 HAMILTON              21/22       Q1/Q2             A                 16
#>  2 HAMILTON              21/22       Q1/Q2             B                  8
#>  3 HAMILTON              21/22       Q3/Q4             A                 17
#>  4 HAMILTON              21/22       Q3/Q4             B                 13
#>  5 HAMILTON              22/23       Q1/Q2             A                 23
#>  6 HAMILTON              22/23       Q1/Q2             B                 10
#>  7 HAMILTON              22/23       Q3/Q4             A                 24
#>  8 HAMILTON              22/23       Q3/Q4             B                  9
#>  9 HAMILTON              23/24       Q1/Q2             A                 16
#> 10 HAMILTON              23/24       Q1/Q2             B                  8
#> # β„Ή 50 more rows

Created on 2024-02-11 with reprex v2.0.2

Session info
sessioninfo::session_info()
#> ─ Session info ───────────────────────────────────────────────────────────────
#>  setting  value
#>  version  R version 4.3.1 (2023-06-16)
#>  os       macOS Ventura 13.6.3
#>  system   x86_64, darwin20
#>  ui       X11
#>  language (EN)
#>  collate  en_US.UTF-8
#>  ctype    en_US.UTF-8
#>  tz       America/Toronto
#>  date     2024-02-11
#>  pandoc   3.1.1 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
#> 
#> ─ Packages ───────────────────────────────────────────────────────────────────
#>  package     * version date (UTC) lib source
#>  cli           3.6.2   2023-12-11 [1] CRAN (R 4.3.0)
#>  colorspace    2.1-0   2023-01-23 [1] CRAN (R 4.3.0)
#>  digest        0.6.33  2023-07-07 [1] CRAN (R 4.3.0)
#>  dplyr       * 1.1.4   2023-11-17 [1] CRAN (R 4.3.0)
#>  evaluate      0.23    2023-11-01 [1] CRAN (R 4.3.0)
#>  fansi         1.0.6   2023-12-08 [1] CRAN (R 4.3.0)
#>  fastmap       1.1.1   2023-02-24 [1] CRAN (R 4.3.0)
#>  forcats     * 1.0.0   2023-01-29 [1] CRAN (R 4.3.0)
#>  fs            1.6.3   2023-07-20 [1] CRAN (R 4.3.0)
#>  generics      0.1.3   2022-07-05 [1] CRAN (R 4.3.0)
#>  ggplot2     * 3.4.4   2023-10-12 [1] CRAN (R 4.3.0)
#>  glue          1.6.2   2022-02-24 [1] CRAN (R 4.3.0)
#>  gtable        0.3.4   2023-08-21 [1] CRAN (R 4.3.0)
#>  hms           1.1.3   2023-03-21 [1] CRAN (R 4.3.0)
#>  htmltools     0.5.7   2023-11-03 [1] CRAN (R 4.3.0)
#>  knitr         1.45    2023-10-30 [1] CRAN (R 4.3.0)
#>  lifecycle     1.0.4   2023-11-07 [1] CRAN (R 4.3.0)
#>  lubridate   * 1.9.3   2023-09-27 [1] CRAN (R 4.3.0)
#>  magrittr      2.0.3   2022-03-30 [1] CRAN (R 4.3.0)
#>  munsell       0.5.0   2018-06-12 [1] CRAN (R 4.3.0)
#>  pillar        1.9.0   2023-03-22 [1] CRAN (R 4.3.0)
#>  pkgconfig     2.0.3   2019-09-22 [1] CRAN (R 4.3.0)
#>  purrr       * 1.0.2   2023-08-10 [1] CRAN (R 4.3.0)
#>  R.cache       0.16.0  2022-07-21 [1] CRAN (R 4.3.0)
#>  R.methodsS3   1.8.2   2022-06-13 [1] CRAN (R 4.3.0)
#>  R.oo          1.25.0  2022-06-12 [1] CRAN (R 4.3.0)
#>  R.utils       2.12.3  2023-11-18 [1] CRAN (R 4.3.0)
#>  R6            2.5.1   2021-08-19 [1] CRAN (R 4.3.0)
#>  readr       * 2.1.4   2023-02-10 [1] CRAN (R 4.3.0)
#>  reprex        2.0.2   2022-08-17 [1] CRAN (R 4.3.0)
#>  rlang         1.1.2   2023-11-04 [1] CRAN (R 4.3.0)
#>  rmarkdown     2.25    2023-09-18 [1] CRAN (R 4.3.0)
#>  rstudioapi    0.15.0  2023-07-07 [1] CRAN (R 4.3.0)
#>  scales        1.3.0   2023-11-28 [1] CRAN (R 4.3.0)
#>  sessioninfo   1.2.2   2021-12-06 [1] CRAN (R 4.3.0)
#>  stringi       1.8.3   2023-12-11 [1] CRAN (R 4.3.0)
#>  stringr     * 1.5.1   2023-11-14 [1] CRAN (R 4.3.0)
#>  styler        1.10.2  2023-08-29 [1] CRAN (R 4.3.0)
#>  tibble      * 3.2.1   2023-03-20 [1] CRAN (R 4.3.0)
#>  tidyr       * 1.3.0   2023-01-24 [1] CRAN (R 4.3.0)
#>  tidyselect    1.2.0   2022-10-10 [1] CRAN (R 4.3.0)
#>  tidyverse   * 2.0.0   2023-02-22 [1] CRAN (R 4.3.0)
#>  timechange    0.2.0   2023-01-11 [1] CRAN (R 4.3.0)
#>  tzdb          0.4.0   2023-05-12 [1] CRAN (R 4.3.0)
#>  utf8          1.2.4   2023-10-22 [1] CRAN (R 4.3.0)
#>  vctrs         0.6.5   2023-12-01 [1] CRAN (R 4.3.0)
#>  withr         2.5.2   2023-10-30 [1] CRAN (R 4.3.0)
#>  xfun          0.41    2023-11-01 [1] CRAN (R 4.3.0)
#>  yaml          2.3.8   2023-12-11 [1] CRAN (R 4.3.0)
#> 
#>  [1] /Users/timothychisamore/Library/R/x86_64/4.3/library
#>  [2] /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/library
#> 
#> ──────────────────────────────────────────────────────────────────────────────

However, this would then display these values on the plot which you may not want. Alternatively, you may be able to adjust this behaviour in the position argument of geom_col somehow, as you can for dodged plots but I am not sure if it will work for stacked ones.

All the best,

Tim

Hi Tim,

You straight up nailed the landing with ggh4x. I finally read through the documentation and found that there are nested facet options - which is amazing. This is a great package!

Here is the output with the original dataset (not using the β€œcomplete” version where we add the zeros to the missing quarters_combined.

The only odd thing is that this nested facet forces the missing quarters_combined to appear. I haven’t been able to figure out how to remove them but it is a small price to pay for the simplicity of the coding without the need for cowplot.

# install and load packages
pacman::p_load(tidyverse, ggh4x)

data_grouped <- tibble::tribble(
  ~total_hospital_region, ~fiscal_year, ~quarters_combined, ~outcome_detail,  ~n,
  "TORONTO",      "21/22",            "Q1/Q2",                 "A", 39L,
  "TORONTO",      "21/22",            "Q1/Q2",                 "B", 19L,
  "TORONTO",      "21/22",            "Q3/Q4",                 "A", 51L,
  "TORONTO",      "21/22",            "Q3/Q4",                 "B", 34L,
  "TORONTO",      "22/23",            "Q1/Q2",                 "A", 48L,
  "TORONTO",      "22/23",            "Q1/Q2",                 "B", 29L,
  "TORONTO",      "22/23",            "Q3/Q4",                 "A", 44L,
  "TORONTO",      "22/23",            "Q3/Q4",                 "B", 21L,
  "TORONTO",      "23/24",            "Q1/Q2",                 "A", 43L,
  "TORONTO",      "23/24",            "Q1/Q2",                 "B", 26L,
  "LONDON",      "21/22",            "Q1/Q2",                 "A", 19L,
  "LONDON",      "21/22",            "Q1/Q2",                 "B", 13L,
  "LONDON",      "21/22",            "Q3/Q4",                 "A", 21L,
  "LONDON",      "21/22",            "Q3/Q4",                 "B", 12L,
  "LONDON",      "22/23",            "Q1/Q2",                 "A", 18L,
  "LONDON",      "22/23",            "Q1/Q2",                 "B", 14L,
  "LONDON",      "22/23",            "Q3/Q4",                 "A", 22L,
  "LONDON",      "22/23",            "Q3/Q4",                 "B", 11L,
  "LONDON",      "23/24",            "Q1/Q2",                 "A", 16L,
  "LONDON",      "23/24",            "Q1/Q2",                 "B", 18L,
  "HAMILTON",      "21/22",            "Q1/Q2",                 "A", 16L,
  "HAMILTON",      "21/22",            "Q1/Q2",                 "B",  8L,
  "HAMILTON",      "21/22",            "Q3/Q4",                 "A", 17L,
  "HAMILTON",      "21/22",            "Q3/Q4",                 "B", 13L,
  "HAMILTON",      "22/23",            "Q1/Q2",                 "A", 23L,
  "HAMILTON",      "22/23",            "Q1/Q2",                 "B", 10L,
  "HAMILTON",      "22/23",            "Q3/Q4",                 "A", 24L,
  "HAMILTON",      "22/23",            "Q3/Q4",                 "B",  9L,
  "HAMILTON",      "23/24",            "Q1/Q2",                 "A", 16L,
  "HAMILTON",      "23/24",            "Q1/Q2",                 "B",  8L,
  "OTTAWA",      "21/22",            "Q1/Q2",                 "A", 10L,
  "OTTAWA",      "21/22",            "Q1/Q2",                 "B",  5L,
  "OTTAWA",      "21/22",            "Q3/Q4",                 "A",  9L,
  "OTTAWA",      "21/22",            "Q3/Q4",                 "B",  4L,
  "OTTAWA",      "22/23",            "Q1/Q2",                 "A",  9L,
  "OTTAWA",      "22/23",            "Q1/Q2",                 "B",  6L,
  "OTTAWA",      "22/23",            "Q3/Q4",                 "A",  9L,
  "OTTAWA",      "22/23",            "Q3/Q4",                 "B", 10L,
  "OTTAWA",      "23/24",            "Q1/Q2",                 "A",  9L,
  "OTTAWA",      "23/24",            "Q1/Q2",                 "B", 12L,
  "KINGSTON",      "21/22",            "Q1/Q2",                 "A",  5L,
  "KINGSTON",      "21/22",            "Q1/Q2",                 "B",  1L,
  "KINGSTON",      "21/22",            "Q3/Q4",                 "A",  2L,
  "KINGSTON",      "21/22",            "Q3/Q4",                 "B",  3L,
  "KINGSTON",      "22/23",            "Q1/Q2",                 "A", 10L,
  "KINGSTON",      "22/23",            "Q3/Q4",                 "A",  2L,
  "KINGSTON",      "22/23",            "Q3/Q4",                 "B",  2L,
  "KINGSTON",      "23/24",            "Q1/Q2",                 "A",  7L,
  "KINGSTON",      "23/24",            "Q1/Q2",                 "B",  1L
)

plot2 <- ggplot(data_grouped %>% 
                mutate(total_hospital_region = fct_relevel(total_hospital_region, c("TORONTO", "LONDON", "HAMILTON", "OTTAWA", "KINGSTON"))),
               aes(x = quarters_combined, y = n, fill = outcome_detail)) +
  
  # Stacked bar chart
  geom_col(position = "stack", color = "white") +
  
  # Add data labels
  geom_text(aes(label = n), position = position_stack(vjust = 0.75), size = 3) +
  
  
  # Customize axes labels and title
  labs(x = NULL, y = NULL) +
  
  # Facet by fiscal_year
  facet_nested(~total_hospital_region + fiscal_year, switch = "x") +
  
  # Customize theme if necessary
  theme_minimal() +
  
  # Customize legend
  scale_fill_manual(name = "Outcome Detail", values = setNames(colors, c("B", "A"))) +
  
  # Adjust x-axis labels
  theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust = 0.5),
        legend.position = "bottom",
        legend.title = element_blank(),
        strip.placement = "outside",
        plot.title.position = "plot",
        plot.title = element_text(hjust = 0.5),
        axis.title.y = element_blank() #,  # Remove y-axis title for all regions

        )

plot2

Thanks again for your help. I couldn’t have done any of this without your inspiration!

O.

1 Like

Hi Oren,

Happy to hear it all worked out!

My guess is that ggh4x uses a similar method underneath whereby all combinations of the nested variables are included so as to avoid the changing bar widths you were running into. It seems like a gap that you can avoid this with position_dodge() but not position_stack(), but there may be some reason that I am unaware of.

All the best,

Tim

1 Like

Hi Oren,

A couple of additional suggestions for you:

You could facet-wrap according to area and play around with the theme so that it looks like the excel chart for the third (place) axis, then use a function like the one below to get the second axis (2-digit year). I’ve used this function on an epi curve before, and it looks quite reasonable - only issue is that I couldn’t figure out how to reliably centre the labels in the sub-area, so they appear just to the right of the bar (but maybe others can figure this out):

label_date_axis <- function(x) {

  firstline = paste0("Q", quarter(x))

  prefix = strftime(x, format = firstline)
  
  years = lubridate::year(x)
  
  if_else(is.na(lag(years)) | lag(years) != years,
          true = stringr::str_glue("**| {prefix}<br>|<br>| {years}**"), 
          false = stringr::str_glue(" {prefix}"))
}

To use the function:

x is a vector of dates to make the first two (date) axes with.

You can then use it with scale_x_date() as below:

# Use the function to label a ggplot axis:
scale_x_date(date_breaks = "quarter", 
                       minor_breaks = NULL, 
                       expand = expansion(add = 3), 
                       labels = label_date_axis)
1 Like

Just realised there is a much more interesting solution above than my hack :wink:

1 Like

Hey Amy! Thanks for the suggestion. I didn’t think to use a function but I will give it a test run. It isn’t easy to replicate this Excel graph as nothing seems to be perfect. The one I made at the end using ggh4x seems to cluster the quarters within the fiscal_year values together - which looks odd. Plus I have an additional task of adding annotations to the graph. Annotations don’t seem to play nicely with two tiered facets so any additional options are appreciated.

Thanks for your help!

O.

2 Likes

I just tried facet_nested() for an epicurve with week, month and year. It is not bad, except that unfortunately weeks that overlap the end of one month and beginning of the next are duplicated. I wonder if there’s a way to fix that? I saw labeller() is one of the arguments in the function, so maybe there is a way to explicitly apply it to dates.

Just in case of interest, here is how it looks with the intro course ebola surv data:

surv %>% 
  mutate(do_year = lubridate::year(date_onset)) %>% 
  mutate(do_month = lubridate::month(date_onset)) %>% 
  mutate(do_week = lubridate::week(date_onset)) %>% 
  drop_na(date_onset) %>% 
ggplot(mapping = aes(x = do_week)) +
  geom_histogram() +
  ggh4x::facet_nested(~do_year + do_month, switch = "x", scales = "free") +
  theme_minimal() +
  theme(
    strip.placement = "outside"
  )

1 Like

Hi Amy,

This situation is interesting because there is a legitimate reason for a a week number to exists between two month numbers - which causes this duplication in the faceting. To me, this facet is correct based on the data. What I would do in this case is to assign each week to a month even if the week crosses over to a new month. Think of it like how we assign epiweek 53 to the previous year even though it actually crosses over into the new year.

I fix this week overlap issue using an index to label the first day of that do_week group then use a case_when statement to push the do_month to the do_week when the index == 1. I can then fill down the rest of the do_month values to assign the month to that week.

surv_facet <- surv %>% 
  mutate(do_year = lubridate::year(date_onset)) %>% 
  mutate(do_month = lubridate::month(date_onset)) %>% 
  mutate(do_week = lubridate::week(date_onset)) %>% 
  arrange(date_onset) %>% 
  group_by(do_week) %>% 
  mutate(index = row_number()) %>% 
  mutate(do_month_filled = case_when(
    index == 1 ~ do_month,
    .default = NA
  )) %>% 
  fill(do_month_filled, .direction = "down")

We can now make the nested faceted graph:

surv_facet %>% 
  drop_na(date_onset) %>%
  ggplot(mapping = aes(x = do_week)) +
  geom_histogram() +
  ggh4x::facet_nested(~do_year + do_month_filled, switch = "x", scales = "free") +
  theme_minimal() +
  theme(
    strip.placement = "outside"
  )

Which turns out like this but has wonky x-axis spacing. I think this can be fixed.

Ok. Just my thoughts. Hope this helps.

1 Like

Hi Oren, try removing scales = β€œfree_x” from facet_wrap() to allow all the bars to be of the same width.

2 Likes

Good catch! I’ll remove the β€œfree_x” and see what I get. Thanks!

1 Like

Nice - that makes sense to reassign / combine them in that way. I’m thinking this could be quite a versatile approach - with a bit of formatting / playing around with geom_col/bar etc, it would be a good way to get the MS Excel β€˜triple axis’ effect (though month names would be nicer than digits - I guess easiest way to achieve that would be to keep the three columns for day month and year as date format, then use date_labels to format as months).

1 Like

Hi Amy,

There might be another way to deal with your example. There is an argument called bleed within strip_nested that might work.

According to the reference page:

The bleed argument controls whether lower-layer strips are allowed to be merged when higher-layer strips are different, i.e. they can bleed over hierarchies. Suppose the strip_vanilla() behaviour would be the following for strips:

[_1_][_2_][_2_]
[_3_][_3_][_4_]

In such case, the default bleed = FALSE argument would result in the following:

[_1_][___2____]
[_3_][_3_][_4_]

Whereas bleed = TRUE would allow the following:

[_1_][___2____]
[___3____][_4_]

The settings never end!

You can find it here:

1 Like