Last active
August 25, 2020 13:03
Star
You must be signed in to star a gist
気象庁 観測史上の記録
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#################################### | |
# 気象庁 観測史上の記録 | |
#################################### | |
library(tidyverse) | |
library(jmastats) # remotes::install_gitlab("uribo/jmastats") | |
library(ggalt) | |
library(sf) | |
library(patchwork) | |
tgt_st_block_no <- c("47418", "47407", "47412", "47575", "47582", "47590", "47615", "47662", | |
"47610", "47604", "47605", "47636", "47772", "47741", "47765", "47891", | |
"47893", "47807", "47827", "47909", "47936", "47918", "47971") | |
sf_target_st <- | |
stations %>% | |
distinct(area, station_no, station_name, block_no) %>% | |
filter(block_no %in% tgt_st_block_no) %>% | |
group_by(block_no) %>% | |
slice(1L) %>% | |
ungroup() %>% | |
assertr::verify(dim(.) == c(23, 5)) | |
# mapview::mapview(sf_target_st) | |
tgt_st_block_no | |
jma_record_temp <- function(year, block_no, type = c("高い", "低い")) { | |
d <- | |
jmastats::jma_collect(item = "rank", block_no = block_no, year = year) %>% | |
filter(str_detect(element, glue::glue("日最高気温の{type}方から"))) | |
if (nrow(d) == 0) | |
rlang::abort("データがありません") | |
d %>% | |
select(element, value, date, period) %>% | |
mutate(value = as.numeric(value), | |
date = lubridate::as_date(date)) | |
} | |
mod_record_data <- function(data) { | |
data %>% | |
arrange(date) %>% | |
mutate(y = row_number(), | |
to_date = tidyr::replace_na(lead(date), | |
lubridate::today())) %>% | |
rename(from_date = date) %>% | |
mutate(y_value = paste0(format(from_date, "%Y年%m月%d日"), | |
"\n", | |
value, | |
"\u2103") %>% | |
forcats::fct_inorder(), | |
days = as.numeric(to_date - from_date)) | |
} | |
plot_jma_record_interval_base <- function(data, station_name) { | |
d <- | |
data %>% | |
filter(lubridate::year(from_date) >= 1990) | |
y_longest <- | |
as.character(d$y_value[which.max(dplyr::min_rank(d$days))]) | |
d %>% | |
ggplot(aes(x = from_date, | |
y = y_value, | |
xend = to_date)) + | |
geom_text(aes(x = from_date + floor((to_date - from_date) / 2), | |
label = paste0(days, "日")), | |
nudge_y = -0.25, | |
size = 1.6, | |
fontface = "bold", | |
family = "Klee-Medium") + | |
geom_dumbbell(data = d %>% | |
filter(str_detect(y_value, | |
y_longest)), | |
color = "#32478B") + | |
geom_dumbbell(data = d %>% | |
filter(str_detect(y_value, | |
y_longest, | |
negate = TRUE)), | |
color = "gray") + | |
# gghighlight(str_detect(y_value, as.character(d$y_value[dplyr::min_rank(d$days)[1]])), | |
# unhighlighted_params = list(color = "gray", | |
# type = 2)) + | |
scale_x_date(limits = c(lubridate::ymd(19900101), | |
lubridate::today()), | |
date_labels = "%Y年") + | |
theme_light(base_family = "Klee-Medium", base_size = 6) + | |
labs(subtitle = glue::glue("観測地点: {station_name}")) + | |
ylab(NULL) + | |
xlab(NULL) | |
} | |
plot_jma_record_interval <- function(data, station_name) { | |
plot_jma_record_interval_base(data, station_name) + | |
labs(title = "1990年以降の日最高気温、観測史上の記録継続期間", | |
caption = "日数が最も長い期間をハイライト\nSource: 気象庁 過去の気象データ検索 http://www.data.jma.go.jp/obd/stats/etrn/index.php\n | |
瓜生真也が加工・編集") | |
} | |
df_jma_records <- | |
tgt_st_block_no %>% | |
purrr::map_dfr(~ jmastats::jma_collect(item = "rank", block_no = .x, year = 2020) %>% | |
mutate(block_no = .x)) | |
df_jma_records_htemp <- | |
df_jma_records %>% | |
filter(str_detect(element, glue::glue("日最高気温の高い方から"))) %>% | |
select(block_no, element, value, date, period) %>% | |
mutate(value = as.numeric(value), | |
date = lubridate::as_date(date)) | |
res <- | |
df_jma_records_htemp %>% | |
left_join(stations %>% | |
st_drop_geometry() %>% | |
distinct(block_no, station_name), | |
by = "block_no") %>% | |
group_by(block_no) %>% | |
group_modify(~ mod_record_data(.x)) %>% | |
ungroup() %>% | |
group_by(block_no) %>% | |
group_map(~ plot_jma_record_interval_base(data = .x, station_name = .x$station_name)) | |
res %>% | |
wrap_plots() + | |
plot_annotation(title = "1990年以降の日最高気温における観測史上上位記録の継続期間", | |
caption = "日数が最も長い期間をハイライト\nSource: 気象庁 過去の気象データ検索 http://www.data.jma.go.jp/obd/stats/etrn/index.php\n | |
瓜生真也が加工・編集", | |
theme = theme(text = element_text(family = "Klee-Medium"))) | |
ggsave("out.png", last_plot(), width = 15, height = 10, dpi = 320) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment