How to change colors scheme in calendar heatmap in R?

Question

I am seeking some assistance in modifying my code to achieve color scheme shown in the below heatmap.

The above heatmap is adapted from the code here

I have managed to produce similar heatmap, but I've got only blue colors. I would like the colors to be adjusted based on the temperature values. As shown in the above heatmap, I'd like the color to be

darker blue if temperature is less than or equal to 9 degree Celsius (tr <= 9)

in the increasing order of lighter blue if temperature is between 9 & 22 (tr > 9 & <= 22)

in the increasing order of darker red if temperature gets above 22 (tr > 22)

Here is my current code

# paquetes
library(tidyverse)
library(lubridate)
library(ragg)

# color ramp
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 = 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)
  )
}

# data

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()

#> Adding missing grouping variables: `month`

dat_tr <- mutate(
  dat_tr,
  week = case_when(
    month == "December" & week == 1 ~ 53,
    month == "January" &
      week %in% 52:53 ~ 0,
    TRUE ~ week
  ),
  pcat = cut(tr, c(1.8, 3:7, 9, 15, 22, 29)),
  text_col = ifelse(pcat %in% c("(9,15]", "(15,22]"), "white", "black"))


calendar_combined_temp <- ggplot(dat_tr,
                                 aes(weekday, -week, fill = pcat)) +
  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_manual(
    values = c("white", col_p(13)),
    na.value = "grey90",
    drop = FALSE
  ) +
  scale_colour_manual(values = c("black", "white"), guide = FALSE) +
  facet_wrap(vars(year, month),
             scales = "free") +
  labs(title = "Daily mean temperature (°C) durirng field trials (2014-2017)",
       subtitle = "Temperature",
       fill = "degree Celcius") +
  theme_calendar()

Here is the reproducible example

dat_tr <- dput(df2)

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)

Answer 1

It's still rough, but here's using scale_fill_steps2 to come close to what you want.

ggplot(dat_tr, aes(weekday, -week, fill = tr)) +            # use tr instead of pcat
  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_manual(                                      # replaced
  #   values = c("white", col_p(13)),
  #   na.value = "grey90",
  #   drop = FALSE
  # ) +
  scale_fill_steps2(                                        # new
    low = "blue", high = "red",
    midpoint = 22, n.breaks = 10) +
  scale_colour_manual(values = c("black", "white"), guide = "none") +
  facet_wrap(vars(year, month),
             scales = "free") +
  labs(title = "Daily mean temperature (°C) during field trials (2014-2017)",
       subtitle = "Temperature",
       fill = "degree Celcius") +
  theme_calendar()

Changes:

• use a numeric value tr instead of a categorical pcat for fill=
• replace scale_fill_manual with scale_fill_steps2; other variants of this function exist, including scale_fill_stepsn (more than 2 bands)
• fixed typo durirng to during