moe_wbgt_202008.R

library(dplyr)
library(jmastats)
library(ggplot2)
source("https://raw.githubusercontent.com/uribo/japan-heatstroke/master/R/read_moe_wbgt.R")

wbgt_list1 <-
  c(l1_lv5 = "#ff2800",
    l1_lv4 = "#ff9600",
    l1_lv3 = "#faf500",
    l1_lv2 = "#a0d2ff",
    l1_lv1 = "#a4d5fd")

df_stations <-
  jmastats::stations %>%
  filter(station_name %in% c("釧路", "旭川", "札幌", "青森", "秋田",
                             "仙台", "宇都宮", "東京", "長野",
                             "新潟", "金沢", "名古屋", "大阪", "松江",
                             "広島", "高松", "高知", "福岡", "鹿児島",
                             "名瀬", "那覇", "石垣島", "父島")) %>%
  group_by(station_name, station_no, pref_code) %>%
  slice(1L) %>%
  ungroup() %>%
  filter(station_no != "23281") %>%
  mutate(station_no = as.character(station_no)) %>%
  sf::st_drop_geometry()

d <-
  read_moe_wbgt(type = "observe", year_month = "202008") %>%
  right_join(df_stations, by = "station_no") %>%
  mutate(datetime = lubridate::as_datetime(paste(date, time),
                                           tz = "Asia/Tokyo")) %>% 
  select(datetime, station_no, station_name, wbgt, area, pref_code) %>% 
  mutate(station_name = forcats::fct_inorder(station_name))

d %>%
  filter(datetime < lubridate::make_datetime(2020, 8, 10, 18, tz = "Asia/Tokyo")) %>% 
  filter(station_name %in% unique(d$station_name)[seq.int(1, 11)]) %>% 
  ggplot(aes(datetime, wbgt, group = station_name)) +
  annotate(geom = "rect",
           xmin = min(d$datetime),
           xmax = max(d$datetime),
           ymin = 31,
           ymax = 40,
           color = "transparent",
           alpha = 0.4,
           fill = wbgt_list1[1]) +
  annotate(geom = "rect",
           xmin = min(d$datetime),
           xmax = max(d$datetime),
           ymin = 28,
           ymax = 31,
           color = "transparent",
           alpha = 0.4,
           fill = wbgt_list1[2]) +
  annotate(geom = "rect",
           xmin = min(d$datetime),
           xmax = max(d$datetime),
           ymin = 25,
           ymax = 28,
           color = "transparent",
           alpha = 0.4,
           fill = wbgt_list1[3]) +
  annotate(geom = "rect",
           xmin = min(d$datetime),
           xmax = max(d$datetime),
           ymin = 21,
           ymax = 25,
           color = "transparent",
           alpha = 0.4,
           fill = wbgt_list1[4]) +
  annotate(geom = "rect",
           xmin = min(d$datetime),
           xmax = max(d$datetime),
           ymin = 15,
           ymax = 21,
           color = "transparent",
           alpha = 0.4,
           fill = wbgt_list1[5]) +
  geom_line() +
  facet_wrap(~ station_name, ncol = 1) +
  scale_x_datetime(date_labels = "%d日\n%H時", 
                   breaks = scales::date_breaks("1 day"),
                   minor_breaks = scales::date_breaks("12 hour")) +
  scale_y_continuous(limits = c(15, 40)) +
  theme_bw(base_family = "Klee-Medium") +
  ylab("暑さ指数(WBGT)") +
  xlab(NULL) +
  labs(title = "暑さ指数",
       subtitle = "2020年8月1日から8月10日",
       caption = "環境省 熱中症予防情報サイト(https://www.wbgt.env.go.jp/)をもとに\n瓜生真也が加工・作成")

ggsave("out1.png", last_plot(), width = 7, height = 12, dpi = 320)