Question

我如何能够把不同年份的几个星期时间与轴心相协调,以便像6月份那样在同一月里发生的几周时间保持一致?

请注意,不同年份的同一周内没有收集数据,因此,几周内无法对数据进行统一,而且数据是假的。我只想把不同年份同期发生的数周时间结合起来。我只想比较不同年份内和不同时期的数据计时模式。

我的守则是:

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)

/></p>
<p>这里是可再生的实例数据集:</p>
<pre><code>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(

Answer 1

这或许是使用<条码>发送<<>>条码/代码>进行这项工作的一轮。基本上,将每一段时间划为每周的序号,并重新采用每周的起步日期,作为标签,因此地块线上:

library(tidyverse)
  
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) {
    date_out <- ymd(paste0(year_n, "0101"))
    week(date_out) <- seq(min_week, max_week)
    wday(date_out) <- 4
    
    str_extract(date_out, "\d{2}-\d{2}$")
    
  })

library(patchwork)

dates_weeks |>
  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_continuous(
        labels = year_breaks[[as.character(year)]],
        breaks = seq(min_week, max_week),
        limits = c(min_week, max_week)
      ) +
      facet_wrap(year, strip.position = "right") +
      scale_fill_manual(values = c("IP" = "blue", "LD" = "red")) +
      theme_minimal(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")
  ) 
#> Warning: Removed 2 rows containing missing values (`geom_col()`).
#> Removed 2 rows containing missing values (`geom_col()`).

https://i.imgur.com/wppCLIH.png” alt=">

Answer 2

library(ggplot2)
library(ggthemes)

ggplot(df[df$total_count != 0,], aes(x = date_in, y = total_count,
                                     fill = Treatment)) +
  geom_col() +
  facet_wrap(~ year, ncol = 1, scales = "free_y", strip.position = "right") + 
  scale_fill_manual(values = c("IP" = "blue", "LD" = "red")) +
  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"),
        legend.position = "top") +
  theme_few(base_size = 10, base_family = "Arial")

^{Created on 2023-09-23 with reprex v2.0.2.}

友情链接