如何在R语言中调整日历热图的温度分段配色方案？

需求说明 #

• 温度≤9℃时，使用深蓝色填充
• 9℃<温度≤22℃时，填充色随温度升高从深蓝色逐渐过渡到浅蓝色
• 温度>22℃时，填充色随温度升高从浅红色逐渐过渡到深红色

修改后的完整代码 #

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

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 = 15),
    
    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_tr <- dat_tr %>%
  rename(tr = temperature) %>%
  complete(date = seq(min(date), max(date), "day")) %>%
  mutate(
    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_tr <- mutate(
  dat_tr,
  week = case_when(
    month == "December" & week == 1 ~ 53,
    month == "January" & week %in% 52:53 ~ 0,
    TRUE ~ week
  ),
  # 调整文字颜色适配新配色：中间蓝段用白色，两端用黑色
  text_col = case_when(
    tr > 9 & tr <= 22 ~ "white",
    TRUE ~ "black"
  )
)

# 绘制日历热图
calendar_combined_temp <- ggplot(dat_tr, aes(weekday, -week, fill = tr)) +
  geom_tile(colour = "white", size = .4)  +
  geom_text(aes(label = day, colour = text_col), size = 2.5) +
  guides(fill = guide_colorsteps(
    barwidth = 25,
    barheight = .4,
    title.position = "top"
  )) +
  # 自定义分段渐变配色
  scale_fill_gradientn(
    colours = c("#003366", "#cceeff", "#ffcccc", "#cc0000"),
    values = scales::rescale(c(-Inf, 9, 22, Inf)),
    na.value = "grey90",
    limits = c(min(dat_tr$tr, na.rm = T), max(dat_tr$tr, na.rm = T))
  ) +
  scale_colour_manual(values = c("black", "white"), guide = FALSE) +
  facet_wrap(vars(year, month), scales = "free") +
  labs(title = "田间试验期间日均温度(°C) (2014-2017)",
       subtitle = "温度分布",
       fill = "摄氏度") +
  theme_calendar()

# 输出图像
print(calendar_combined_temp)

关键修改说明 #

1. 配色逻辑替换：移除原有的PuBu色系，改用scale_fill_gradientn实现分段渐变：
   • 温度≤9℃：固定深蓝色#003366
   • 9℃到22℃：从深蓝色平滑过渡到浅蓝色#cceeff
   • 温度>22℃：从浅红色#ffcccc平滑过渡到深红色#cc0000
2. 数据处理调整：移除原有的pcat分组，直接用连续型的tr值映射填充色，同时调整text_col的判断逻辑，确保文字在不同配色背景下的可读性。
3. 图例优化：保持原有的guide_colorsteps样式，适配连续型颜色渐变的展示。

可复现示例数据 #

dat_tr <- structure(
  list(
    date = structure(
      c(
        16216,16218,16219,16221,16230,16232,16233,16238,16239,16243,
        16576,16582,16583,16586,16587,16588,16589,16590,16591,16592,
        16981,16982,16983,16984,16985,16986,16987,16988,16989,16990,
        17235,17239,17243,17251,17252,17253,17255,17256,17259,17260
      ),
      class = "Date"
    ),
    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),
      .Label = c("2014", "2015", "2016", "2017"), class = "factor"
    ),
    temperature = c(
      25.15,19.875,21.4,17.4333333333333,21.38,20.82,19.7333333333333,23.3666666666667,19,22.15,
      16.3000003814697,19.8999996185303,20.8416665395101,25,19.1714284079415,17.7875001430511,15.6000003814697,16.3666664759318,21.2999999523163,22.6333332061768,
      28.2000007629395,24.5,19.5,21.7799999237061,24.1000003814697,19.6499999761581,22.8499999046326,24.8999996185303,23.7000007629395,21.0999996185303,
      10.7000000476837,1.88888888447373,5.04999995231628,13.8666664759318,14.5199998855591,14.9357141767229,12.447368471246,11.2146341277332,10.7999997138977,12.3066666285197
    )
  ),
  class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
  row.names = c(NA,-40L),
  groups = structure(
    list(
      year = structure(1:4, .Label = c("2014", "2015", "2016", "2017"), class = "factor"),
      .rows = structure(list(1:10,11:20,21:30,31:40), 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_tr$date = as.Date(dat_tr$date)

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