How to align weeks in different years in ggplot2?

How can I align the weeks from different years on the x-axis so that weeks occurring in the same month, like June, are aligned?

Please note that data was not collected during same weeks in different years, so some weeks can't be aligned, and that's okay. I just wish to align weeks that occurred in the same months in different years to compare temporal patterns of counts across different weeks in different years.

Here is my code:

p <- ggplot(df, aes(x = date_in, y = total_count, fill = Treatment)) +
  geom_col() +
  facet_grid(year ~ .) +  # Stacking years on top of each other
  theme_few(base_size = 10, base_family = "Arial") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1, 
                                   vjust = 0.5, color = "black"),
        axis.text.y = element_text(vjust = 0.5, color = "black"),
        axis.title = element_text(color = "black"),  
        strip.text = element_text(face = "bold", color = "black")) + 
  facet_wrap(~ year, ncol = 1, scales = "free", 
                     strip.position = "right") + # Righty-axis
  theme(legend.position = "top") +
  scale_fill_manual(values = c("IP" = "blue", "LD" = "red"))  # Set custom colors

# Print the plot
print(p)

Here is the reproducible example dataset:

df <- structure(list(date_in = structure(c(7L, 11L, 11L, 13L, 13L, 
15L, 15L, 18L, 18L, 21L, 5L, 5L, 7L, 7L, 9L, 9L, 11L, 11L, 13L, 
13L, 17L, 17L, 20L, 20L, 23L, 23L, 26L, 26L, 28L, 28L, 1L, 1L, 
2L, 2L, 3L, 3L, 4L, 4L, 6L, 6L), levels = c("03/08", "04/05", 
"04/26", "05/17", "05/19", "05/24", "05/26", "05/31", "06/02", 
"06/07", "06/09", "06/14", "06/16", "06/21", "06/23", "06/28", 
"06/29", "06/30", "07/05", "07/06", "07/07", "07/12", "07/13", 
"07/14", "07/19", "07/21", "07/26", "07/28", "08/02", "08/04", 
"08/09", "08/11", "08/16", "08/17", "08/24", "08/25", "08/31", 
"09/01", "09/07", "09/08", "09/14", "09/15", "09/21", "09/22", 
"09/23", "09/28", "09/29", "09/30", "10/05", "10/06", "10/07", 
"10/12", "10/13", "10/14", "10/19", "10/20", "10/21", "10/26", 
"10/27", "10/29", "11/02", "11/03", "11/04", "11/09", "11/11", 
"11/17", "11/23", "12/01", "12/07"), class = "factor"), total_count = c(0L, 
0L, 0L, 0L, 4L, 3L, 13L, 0L, 0L, 16L, 2L, 2L, 18L, 362L, 135L, 
684L, 34L, 123L, 6L, 21L, 2L, 4L, 6L, 6L, 1L, 11L, 0L, 12L, 1L, 
2L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 11L, 0L, 0L), Treatment = structure(c(2L, 
2L, 4L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 2L, 4L, 2L, 4L, 2L, 4L, 2L, 
4L, 4L, 2L, 4L, 2L, 2L, 4L, 4L, 2L, 4L, 2L, 2L, 4L, 2L, 4L, 2L, 
4L, 2L, 4L, 2L, 4L, 2L, 4L), levels = c("between_row", "IP", 
"mulch", "LD"), class = "factor"), year = structure(c(1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 
4L, 4L, 4L, 4L, 4L, 4L), levels = c("2010", "2011", "2012", "2013"
), class = "factor")), class = c("tbl_df", "tbl", "data.frame"
), row.names = c(NA, -40L))

My desired output will look like below

Solution

This is perhaps a round about way of doing it using patchwork. Essentially, plotting each with breaks as the week number and re-applying start-week dates as labels so the plots line up:

library(tidyverse)
library(ggthemes)

dates_weeks <- df |>
  mutate(date = mdy(paste0(date_in, year)),
         week = week(date)) 

min_week <- min(dates_weeks$week)
max_week <- max(dates_weeks$week)

year_breaks <- 2010:2013 |>
  set_names() |>
  map(\(year_n) {
    
    year_dat <- dates_weeks |> 
      filter(year == year_n) |> 
      select(date_in, week) |> 
      unique()
    
    week_map <- character(max_week - min_week + 1)
    names(week_map) <- seq(min_week, max_week)
    
    week_map[as.character(year_dat$week)] <- as.character(year_dat$date_in)
    
    
    week_map
    
  })

library(patchwork)

dates_weeks |>
  mutate(week = factor(week), Treatment = factor(Treatment)) |> 
  nest(data = -year) |>
  mutate(pl = map2(data, year, \(data, year) {
    # browser()
    
    ggplot(data, aes(x = week, y = total_count, fill = Treatment)) +
      geom_col() +
      scale_x_discrete(
        labels = year_breaks[[as.character(year)]],
        drop = FALSE
      ) +
      facet_wrap(year, strip.position = "right") +
      scale_fill_manual(values = c("IP" = "blue", "LD" = "red"), drop = FALSE) +
      theme_few(base_size = 10)
    
  })) |>
  pull(pl) |>
  wrap_plots(ncol = 1) +
  plot_layout(guides = "collect") &
  theme(
    legend.position = "top",
    axis.text.x = element_text(
      angle = 90,
      hjust = 1,
      vjust = 0.5,
      color = "black"
    ),
    axis.text.y = element_text(vjust = 0.5, color = "black"),
    axis.title = element_text(color = "black"),
    strip.text = element_text(face = "bold", color = "black")
  )