如何在 R 中按年份分面日历热图？

问：

我正在尝试复制热图的代码，如下所示。

我在这里找到了创建此热图的代码。但是，我的数据包括来自两个地点的四年实验的某些月份，我想在一个数字中显示所有四年，按月份和年份分面。目前，它仅按月分面一年。

我已经设法为每年按月刻面创建单独的热图，但我不确定如何获得一个按月和年刻面的单个图形。这是我当前的代码 - 它不会接受以下代码中的步骤。有人可以帮我修改此代码以按年份创建分面图，以便我可以在一个图形中看到所有四年吗？year facet_wrap( ~ month,

# 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)
  )
}


dat_prr <- dat_prr %>%
  rename(pr = precipitation) %>%
  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_prr <- mutate(
  dat_prr,
  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_Lowgap <- ggplot(dat_prr,
                          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( ~ month,
              nrow = 4,
              ncol = 3,
              scales = "free") +
  labs(title = "Rainfall durirng trials from 2015 to 2017",
       subtitle = "Rainfall",
       fill = "mm") +
  theme_calendar()

这是可重复的例子

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) 

[![在此输入图片描述][3]][3]