如何在R中按年份与月份分面绘制日历热力图？

问题说明 #

现有四年（2014-2017）的降水实验数据，需要绘制日历热力图并按年份+月份组合分面，在同一幅图中展示所有年度的月度日历。原代码仅支持单一年度按月分面，无法直接在facet_wrap中加入year参数实现多年度整合展示。

修改后的完整代码 #

# 加载包
library(tidyverse)
library(lubridate)
library(RColorBrewer)

# 颜色渐变配置
pubu <- RColorBrewer::brewer.pal(9, "PuBu")
col_p <- colorRampPalette(pubu)

# 自定义日历主题
theme_calendar <- function() {
  theme(
    aspect.ratio = 1 / 2,
    
    axis.title = element_blank(),
    axis.ticks = element_blank(),
    axis.text.y = element_blank(),
    axis.text = element_text(),
    
    panel.grid = element_blank(),
    panel.background = element_blank(),
    
    strip.background = element_blank(),
    strip.text = element_text(face = "bold", size = 10),
    
    legend.position = "top",
    legend.text = element_text(hjust = .5),
    legend.title = element_text(size = 9, hjust = 1),
    
    plot.caption =  element_text(hjust = 1, size = 8),
    panel.border = element_rect(
      colour = "grey",
      fill = NA,
      size = 1
    ),
    plot.title = element_text(
      hjust = .5,
      size = 26,
      face = "bold",
      margin = margin(0, 0, 0.5, 0, unit = "cm")
    ),
    plot.subtitle = element_text(hjust = .5, size = 16)
  )
}

# 数据处理：先取消分组避免冲突
dat_prr <- dat_prr %>%
  ungroup() %>%
  rename(pr = precipitation) %>%
  complete(date = seq(min(date), max(date), "day")) %>%
  mutate(
    year = factor(lubridate::year(date)),
    weekday = lubridate::wday(date, label = T, week_start = 1),
    month = lubridate::month(date, label = T, abbr = F),
    week = isoweek(date),
    day = day(date)
  ) %>%
  na.omit()

# 调整跨年周的计算逻辑
dat_prr <- dat_prr %>%
  mutate(
    week = case_when(
      month == "December" & week == 1 ~ 53,
      month == "January" & week %in% 52:53 ~ 0,
      TRUE ~ week
    ),
    pcat = cut(pr, c(-1, 0, 0.5, 1:5, 7, 9, 25, 75)),
    text_col = ifelse(pcat %in% c("(7,9]", "(9,25]"), "white", "black")
  )

# 绘制多年度日历热力图
calendar_all_years <- ggplot(dat_prr, aes(weekday, -week, fill = pcat)) +
  geom_tile(colour = "white", size = .4)  +
  geom_text(aes(label = day, colour = text_col), size = 2) +
  guides(fill = guide_colorsteps(
    barwidth = 25,
    barheight = .4,
    title.position = "top"
  )) +
  scale_fill_manual(
    values = c("white", col_p(13)),
    na.value = "grey90",
    drop = FALSE
  ) +
  scale_colour_manual(values = c("black", "white"), guide = FALSE) +
  # 按年份为行、月份为列分面，自动适配各年月的周数范围
  facet_grid(year ~ month, scales = "free") +
  labs(title = "2014-2017年实验期间降雨量",
       subtitle = "日历热力图",
       fill = "降雨量(mm)") +
  theme_calendar()

# 输出图形
print(calendar_all_years)

关键修改点 #

• 数据预处理：先取消数据分组（ungroup()），避免complete()函数出现分组冲突；确保year字段为因子类型，保证分面时的正确排序。
• 分面逻辑：将原facet_wrap(~ month)替换为facet_grid(year ~ month)，实现按年份行、月份列的矩阵式分面，清晰展示每一年的所有月份数据。
• 细节适配：适当缩小子图中的文字大小，避免多子图布局时出现文字挤压。

可复现数据 #

dat_prr <- structure(
  list(
    date = structure(
      c(
        16216,16217,16218,16219,16220,16221,16222,16223,16230,16231,
        16232,16233,16234,16235,16236,16574,16575,16576,16577,16578,
        16579,16580,16581,16582,16583,16584,16585,16586,16587,16588,
        16981,16982,16983,16984,16985,16986,16987,16988,16989,16990,
        16991,16992,16993,16994,16995,17233,17234,17235,17236,17237,
        17238,17239,17240,17241,17242,17243,17244,17245,17246,17247
      ),
      class = "Date"
    ),
    year = structure(
      c(1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,1L,2L,2L,2L,2L,2L,
        2L,2L,2L,2L,2L,2L,2L,2L,2L,2L,3L,3L,3L,3L,3L,3L,3L,3L,3L,3L,
        3L,3L,3L,3L,3L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L,4L),
      .Label = c("2014", "2015", "2016", "2017"), class = "factor"
    ),
    precipitation = c(
      0.8,0,1.4,3,0,1,0,0,3,0,2.4,1.2,0,0,0,0,0,1.00000001490116,0,0,
      0,0,0,1.40000002086163,19.8000004887581,0,0,0.200000002980232,
      5.20000007748604,3.00000007450581,0.400000005960464,0.200000002980232,
      6.00000014901161,26.3999992460012,0.800000011920929,19.999999910593,
      1.40000002086163,1,0.800000011920929,3.60000005364418,0.200000002980232,
      0.200000002980232,0,6.79999981820583,0,0,0,2.20000003278255,0,0,0,
      9.00000016391277,0,0,0,2.80000004172325,0,0,0,0
    )
  ),
  class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
  row.names = c(NA,-60L),
  groups = structure(
    list(
      year = structure(1:4, .Label = c("2014", "2015", "2016", "2017"), class = "factor"),
      .rows = structure(list(1:15,16:30,31:45,46:60), ptype = integer(0), 
                        class = c("vctrs_list_of", "vctrs_vctr", "list"))
    ),
    row.names = c(NA,-4L), class = c("tbl_df", "tbl", "data.frame"), .drop = TRUE
  )
)

dat_prr$date = as.Date(dat_prr$date) 

内容的提问来源于stack exchange，提问作者Ahsk