我正在尝试复制热图的代码,如下所示。
我找到了创建这个热图here的代码。但是,我的数据由两个位置的四年实验的某些月份组成,我想在一个图中显示所有四年,按月份和年份显示。目前,它只按月份显示一年。
我已经成功地创建了一个按月份分面的每年的热图,但是我不知道如何得到一个按月份和年份分面的图。下面是我目前的代码-它不接受下面代码中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() {
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]
1条答案
按热度按时间k97glaaz1#
你试过这样吗?