library(readr)
library(dplyr, warn.conflicts = FALSE)
library(ggplot2)
f <- \(...) scale_colour_viridis_d(option = "F", end = 0.94, direction = -1, ..., aesthetics = c("colour", "fill"))
options(
ggplot2.discrete.fill = f,
ggplot2.discrete.colour = f
)
periods <- c("2022", "2022-1")
d <- purrr::map_dfr(periods, \(x) {
read_csv(
glue::glue("https://stopcovid19.metro.tokyo.lg.jp/data/130001_tokyo_covid19_patients_{x}.csv"),
col_types = cols(
No = col_integer(),
全国地方公共団体コード = col_integer(),
公表_年月日 = col_date(),
発症_年月日 = col_date(),
確定_年月日 = col_date(),
患者_渡航歴の有無フラグ = col_logical(),
患者_接触歴の有無フラグ = col_logical(),
退院済フラグ = col_logical(),
.default = col_character()
)
)
})
d |>
count(患者_年代)
#> # A tibble: 13 × 2
#> 患者_年代 n
#> <chr> <int>
#> 1 - 335
#> 2 100歳以上 662
#> 3 10代 218560
#> 4 10歳未満 244988
#> 5 20代 339954
#> 6 30代 305411
#> 7 40代 286082
#> 8 50代 177374
#> 9 60代 79922
#> 10 70代 52067
#> 11 80代 33725
#> 12 90代 13108
#> 13 ー 2
conv_age <- function(患者_年代) {
case_when(
患者_年代 == "10歳未満" ~ "0～9歳",
endsWith(患者_年代, "代") ~ stringr::str_replace(患者_年代, "(\\d+)0代", "\\10～\\19歳"),
患者_年代 == "100歳以上" ~ "100～歳",
.default = NA_character_
)
}
d |>
mutate(
age = conv_age(患者_年代)
) |>
count(age)
#> # A tibble: 12 × 2
#> age n
#> <chr> <int>
#> 1 0～9歳 244988
#> 2 100～歳 662
#> 3 10～19歳 218560
#> 4 20～29歳 339954
#> 5 30～39歳 305411
#> 6 40～49歳 286082
#> 7 50～59歳 177374
#> 8 60～69歳 79922
#> 9 70～79歳 52067
#> 10 80～89歳 33725
#> 11 90～99歳 13108
#> 12 <NA> 337
d_summarized <- d |>
mutate(age = conv_age(患者_年代)) |>
# 不明は取り除く
filter(!is.na(age)) |>
count(
date = 公表_年月日,
# 80歳以上はまとめる
age = forcats::fct_other(
factor(age),
keep = glue::glue("{i}0～{i}9歳", i = c("", 1:7)),
other_level = "80歳以上"
)
) |>
tidyr::complete(date, age, fill = list(n = 0)) |>
group_by(age) |>
mutate(
n_week = slider::slide_period_dbl(n, date, "day", mean, .before = 6)
) |>
ungroup()
p <- ggplot(d_summarized) +
geom_line(aes(date, n_week, colour = age)) +
theme_minimal() +
labs(
title = "東京都 新型コロナウイルス陽性患者発表数の7日間移動平均",
caption = "出典: 東京都 新型コロナウイルス陽性患者発表詳細"
)
p
p +
geom_point(aes(date, n), size = 0.2, alpha = 0.7) +
facet_wrap(vars(age), scales = "free_y") +
guides(colour = "none")
ggplot(d_summarized) +
geom_area(
aes(date, n_week, fill = age),
alpha = 0.5,
colour = alpha("black", 0.6),
position = "fill"
) +
theme_minimal() +
labs(
title = "東京都 新型コロナウイルス陽性患者発表数の7日間移動平均",
caption = "出典: 東京都 新型コロナウイルス陽性患者発表詳細"
)
age <- levels(d_summarized$age)
pal <- scales::viridis_pal(option = "F", end = 0.94, direction = -1)(length(age))
pal <- scales::alpha(pal, if_else(age %in% c("70～79歳", "80歳以上"), 0.9, 0.4))
names(pal) <- age
d_summarized |>
ggplot() +
geom_area(
aes(date, n_week, fill = age),
colour = alpha("black", 0.6),
position = "stack"
) +
scale_fill_manual(values = pal) +
theme_minimal() +
labs(
title = "東京都 新型コロナウイルス陽性患者発表数の7日間移動平均（70歳以上を強調）",
caption = "出典: 東京都 新型コロナウイルス陽性患者発表詳細"
)
Created on 2022-07-31 by the reprex package (v2.0.1)