问题

我正在尝试复制下面显示的热图的代码。

我找到了创建这个热图的代码这里。然而，我的数据包括在两个位置进行的四年实验中的某些月份，我希望在单个图中显示所有四年，按月份和年份分面。目前，它只按年分面。

我已经成功创建了按年分面的各自的热图，但我不确定如何在一个图中显示按月份和年份分面的单一图。这是我的当前代码 - 它在以下代码中的facet_wrap( ~ month,步骤中无法接受year。是否有人可以帮助我修改此代码，以创建一个按年分面的图，以便我可以在单个图中看到所有四年？

以下是您提供的代码片段的翻译。其他内容未被翻译。

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

# color ramp
pubu <- RColorBrewer::brewer.pal(9, "PuBu")
col_p <- colorRampPalette(pubu)

theme_calendar <- function() {
  # 主题设置，包括颜色和标签
}

dat_prr <- dat_prr %>%
  rename(pr = precipitation) %>%
  complete(date = seq(min(date),
                      max(date),
                      "day")) %>%
  mutate(
    # 在数据中进行一些变换
  ) %>%
  na.omit()

dat_prr <- mutate(
  dat_prr,
  week = case_when(
    # 根据月份和周来设置周数
  ),
  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 = "2015年至2017年试验期间的降雨量",
       subtitle = "降雨",
       fill = "mm") +
  theme_calendar()

这是一个可重现的示例：

dat_prr <- structure(
  list(
    date = structure(
      # 数据日期
    ),
    year = structure(
      # 数据年份
    ),
    precipitation = c(
      # 降水数据
    )
  ),
  class = c("grouped_df", "tbl_df", "tbl", "data.frame"),
  row.names = c(NA,-60L),
  groups = structure(
    list(
      year = structure(
        # 年份分组
      ),
      .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]


注意：由于代码部分太长，我只提供了翻译，不包括整个代码。如果您需要完整的代码翻译，请告诉我。
<details>
<summary>英文:</summary>
I am trying to replicate the code for the heatmap as shown below. 
[![enter image description here][1]][1]
I found the code to create this heatmap [here][2]. However, my data consists of certain months from a four-year experiment at two locations, and I want to display all four years in a single figure, facetted by both month &amp; year. Currently, it&#39;s faceted by month for a single year only.
I have managed to create individual heatmaps for each year faceted by month, but I&#39;m not sure how to get a single figure with faceted by both month &amp; year. Here&#39;s my current code - it won&#39;t accept `year` in ` facet_wrap( ~ month,` step in following code. Can someone help me modify this code to create a facetted plot by year, so that I can see all four years in a single figure?

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 = &quot;bold&quot;, size = 15),
legend.position = &quot;top&quot;,
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 = &quot;grey&quot;,
fill = NA,
size = 1
),
plot.title = element_text(
hjust = .5,
size = 26,
face = &quot;bold&quot;,
margin = margin(0, 0, 0.5, 0, unit = &quot;cm&quot;)
),
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()


Here is the reproducible example

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)


[![enter image description here][3]][3]
[1]: https://i.stack.imgur.com/IhCOi.png
[2]: https://dominicroye.github.io/en/2020/a-heatmap-as-calendar/
</details>
# 答案1
**得分**: 0
你试过这样吗？
```r
ggplot(dat_prr,
aes(weekday, -week, fill = pcat)) +
geom_tile(colour = "white", size = 0.4) +
geom_text(aes(label = day, colour = text_col), size = 2.5) +
guides(fill = guide_colorsteps(
barwidth = 25,
barheight = 0.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 = "none") +
facet_wrap(vars(year, month),
nrow = 4,
ncol = 3,
scales = "free") +
labs(title = "2015年至2017年试验期间的降雨量",
subtitle = "降雨",
fill = "mm") +
theme_calendar()
```
[![在此输入图像描述][1]][1]
```
[1]: https://i.stack.imgur.com/N3Cka.png
<details>
<summary>英文:</summary>
Have you tried it like this?
```
ggplot(dat_prr,
aes(weekday,-week, fill = pcat)) +
geom_tile(colour = &quot;white&quot;, size = .4)  +
geom_text(aes(label = day, colour = text_col), size = 2.5) +
guides(fill = guide_colorsteps(
barwidth = 25,
barheight = .4,
title.position = &quot;top&quot;
)) +
scale_fill_manual(
values = c(&quot;white&quot;, col_p(13)),
na.value = &quot;grey90&quot;,
drop = FALSE
) +
scale_colour_manual(values = c(&quot;black&quot;, &quot;white&quot;), guide = &quot;none&quot;) +
facet_wrap(vars(year,month),
nrow = 4,
ncol = 3,
scales = &quot;free&quot;) +
labs(title = &quot;Rainfall durirng trials from 2015 to 2017&quot;,
subtitle = &quot;Rainfall&quot;,
fill = &quot;mm&quot;) +
theme_calendar()
```
[![enter image description here][1]][1]
[1]: https://i.stack.imgur.com/N3Cka.png
</details>

通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。

如何在R中按年份制作日历热图？

问题

paquetes

color ramp

将多列转换为长格式时使用 R 的 pivot_longer 函数。

IV回归与聚类标准误

如何在R中使用ggplot2中的多种颜色比例尺

财务盈亏平衡点，考虑一系列现金流量在R中。

What's the correct way to type hint an empty list as a literal in python?

如何在Highcharts Gantt中更改本地化的星期名称

如何在同一个流中使用多个过滤器和映射函数？

如何使用Map/Set来将代码优化到O(n)？

.NET MAUI Android在GitHub Actions上构建失败，错误代码为1。

如何在Playwright视觉比较中屏蔽多个定位器？

在C++中，可以使用可变模板参数来检索类型的内部类型。

selenium.common.exceptions.StaleElementReferenceException: Message: stale element reference: stale element not found

Creating and opening a URL to log in to Website via Basic Auth with Robot Framework/Selenium (Python)

AG Grid 在上下文菜单中以大文本形式打开

发表评论