英文:
How to facet a calendar heatmap by year in R?
问题
我正在尝试复制下面显示的热图的代码。
我找到了创建这个热图的代码这里。然而，我的数据包括在两个位置进行的四年实验中的某些月份，我希望在单个图中显示所有四年，按月份和年份分面。目前，它只按年分面。
我已经成功创建了按年分面的各自的热图，但我不确定如何在一个图中显示按月份和年份分面的单一图。这是我的当前代码 - 它在以下代码中的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 & year. Currently, it's faceted by month for a single year only.
I have managed to create individual heatmaps for each year faceted by month, but I'm not sure how to get a single figure with faceted by both month & year. Here's my current code - it won'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 = "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()
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 = "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 = "none") +
facet_wrap(vars(year,month),
nrow = 4,
ncol = 3,
scales = "free") +
labs(title = "Rainfall durirng trials from 2015 to 2017",
subtitle = "Rainfall",
fill = "mm") +
theme_calendar()
```
[![enter image description here][1]][1]
[1]: https://i.stack.imgur.com/N3Cka.png
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论