Skip to content

Instantly share code, notes, and snippets.

@kenmomd

kenmomd/covid19tokyo.R

Last active 2 days ago
Star
Embed
Download ZIP
東京都の年代別COVID-19陽性者数の分析
Raw
covid19tokyo.R
#library
library(tidyverse)
library(incidence)
library(lubridate)
library(scales)
library(ggsci)
library(ggthemes)
library(glue)
library(patchwork)
library(jsonlite)
library(curl)
##東京都年代別------------------------------------------
##https://stopcovid19.metro.tokyo.lg.jp/
URL = "https://stopcovid19.metro.tokyo.lg.jp/data/130001_tokyo_covid19_patients.csv"
tokyo <- read_csv(URL,na = c("NA","","'-"))
tail(tokyo)
tokyo$患者_年代 <- fct_relevel(tokyo$患者_年代, "10歳未満","10代","20代","30代","40代","50代","60代","70代","80代","90代","100歳以上","不明")
tokyo <- tokyo %>% rename(age="患者_年代", date="公表_年月日")
#mutate(tokyo, age = na_if(age, "'-"))
tokyo <- tokyo %>% mutate(age2 = case_when(
age == "10歳未満"~"10代以下",
age =="10代"~"10代以下",
age =="20代"~"20-30代",
age =="30代"~"20-30代",
age == "40代" ~ "40-50代",
age == "50代" ~ "40-50代",
age =="60代"~"60-70代",
age =="70代"~"60-70代",
age =="80代"~"80代以上",
age =="90代"~"80代以上",
age =="100歳以上"~"80代以上")) %>% dplyr::filter(Date>="2020-02-24")
tokyo <- tokyo %>% mutate(age3 = case_when(
age == "10歳未満"~"30代以下",
age =="10代"~"30代以下",
age =="20代"~"30代以下",
age =="30代"~"30代以下",
age == "40代" ~ "40-60代",
age == "50代" ~ "40-60代",
age =="60代"~"40-60代",
age =="70代"~"70代以上",
age =="80代"~"70代以上",
age =="90代"~"70代以上",
age =="100歳以上"~"70代以上"))
tokyo <- tokyo %>% dplyr::filter(!is.na(age3))
#incidence確認
dat <- tokyo$date
class(dat)
i <- incidence(dat)
i
plot(i)
##年代別陽性者数　日別------------------------------------------
i.7.age <- incidence(dat, interval = "1 day", groups = tokyo$age3)
i.7.age
#日付など
today <- lubridate::today()
date_last <- length(i.7.age$dates)
date_start_fit <- date_last-13
#直近の倍加時間
f <- incidence::fit(i.7.age[date_start_fit:date_last])
f
##倍加時間抽出------------------------------------------
##増加局面
#DT_30 <- round(f$info$doubling["30代以下"], digits = 1)
#DT_40to60 <- round(f$info$doubling["40-60代"], digits = 1)
#DT_70 <- round(f$info$doubling["70代以上"], digits = 1)
#倍加時間抽出,30代以下のみ減少
DT_30 <- round(f$info$halving["30代以下"], digits = 1)
DT_40to60 <- -round(f$info$halving["40-60代"], digits = 1)
DT_70 <- -round(f$info$halving["70代以上"], digits = 1)
#フォント指定
font_family = "HiraginoSans-W4" # Macの場合
windowsFonts(font_family = windowsFont("Meiryo")) # Windowsの場合
#グラフ描画
lims <- as.Date(strptime(c("2020-03-20","2020-09-30"), format = "%Y-%m-%d"))
p <- plot(i.7.age, stack = FALSE, fit=f)+
scale_x_date(limits = lims, date_breaks = "5 days", labels = date_format(format = "%B%d日"))+
annotate("text", hjust=0, x=today+1, y=150, label=glue("半減期：{DT_30}日"), family=font_family, size=5,colour="#00468BFF")+
annotate("text", hjust=0, x=today+1, y=80, label=glue("倍加時間：{DT_40to60}日"), family=font_family, size=5,colour="#ED0000FF")+
annotate("text", hjust=0, x=today+1, y=30, label=glue("倍加時間：{DT_70}日"), family=font_family, size=5, colour="#42B540FF")+
labs(title="東京都 COVID-19 年代別陽性者数推移",
subtitle = "COVID-19 Confirmed Cases by Age Groups in Tokyo, Japan",
x="", y="New Reported Cases",
caption = "（ヽ´ん`）@kenmomd \nDATA：東京都福祉保健局",
fill = "Age",
colour = "Age")+
theme_bw(base_size = 13, base_family = font_family)+
scale_y_continuous(expand = c(0,0), limits = c(0,400))+
scale_fill_lancet()+
scale_color_lancet()+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
p
ggsave(filename = "./Tokyo-Age_Daiy_c.png", plot=p, width=15, height=9, dpi = 180)
Raw
tokyo_age3_daily.csv
date 30代以下 40-60代 70代以上
2020-01-24 0 1 0
2020-01-25 1 0 0
2020-01-26 0 0 0
2020-01-27 0 0 0
2020-01-28 0 0 0
2020-01-29 0 0 0
2020-01-30 1 0 0
2020-01-31 0 0 0
2020-02-01 0 0 0
2020-02-02 0 0 0
2020-02-03 0 0 0
2020-02-04 0 0 0
2020-02-05 0 0 0
2020-02-06 0 0 0
2020-02-07 0 0 0
2020-02-08 0 0 0
2020-02-09 0 0 0
2020-02-10 0 0 0
2020-02-11 0 0 0
2020-02-12 0 0 0
2020-02-13 0 0 1
2020-02-14 0 1 1
2020-02-15 0 5 3
2020-02-16 2 3 0
2020-02-17 0 0 0
2020-02-18 1 1 1
2020-02-19 0 0 3
2020-02-20 0 0 0
2020-02-21 0 2 1
2020-02-22 0 1 0
2020-02-23 0 0 0
2020-02-24 1 2 0
2020-02-25 0 0 0
2020-02-26 0 0 3
2020-02-27 0 1 0
2020-02-28 0 0 0
2020-02-29 1 0 0
2020-03-01 0 1 1
2020-03-02 0 0 0
2020-03-03 0 1 0
2020-03-04 1 2 1
2020-03-05 4 0 4
2020-03-06 2 2 2
2020-03-07 0 4 2
2020-03-08 0 0 0
2020-03-09 0 0 0
2020-03-10 0 2 1
2020-03-11 1 4 1
2020-03-12 0 1 1
2020-03-13 0 1 1
2020-03-14 2 7 1
2020-03-15 2 1 0
2020-03-16 0 0 0
2020-03-17 0 12 0
2020-03-18 4 3 2
2020-03-19 1 5 1
2020-03-20 2 8 1
2020-03-21 2 5 0
2020-03-22 1 2 0
2020-03-23 2 10 4
2020-03-24 10 7 1
2020-03-25 10 24 7
2020-03-26 12 20 14
2020-03-27 12 16 12
2020-03-28 17 24 23
2020-03-29 44 23 5
2020-03-30 3 7 2
2020-03-31 38 31 9
2020-04-01 27 38 2
2020-04-02 42 42 14
2020-04-03 35 43 14
2020-04-04 42 50 26
2020-04-05 73 50 18
2020-04-06 39 39 7
2020-04-07 39 40 8
2020-04-08 69 62 25
2020-04-09 70 86 27
2020-04-10 99 85 15
2020-04-11 77 112 9
2020-04-12 49 51 74
2020-04-13 42 52 6
2020-04-14 56 89 13
2020-04-15 37 63 27
2020-04-16 66 67 18
2020-04-17 69 96 39
2020-04-18 71 80 35
2020-04-19 39 47 23
2020-04-20 41 43 17
2020-04-21 38 65 20
2020-04-22 59 44 20
2020-04-23 49 48 37
2020-04-24 69 61 38
2020-04-25 36 54 28
2020-04-26 26 32 24
2020-04-27 17 13 11
2020-04-28 39 40 34
2020-04-29 18 16 13
2020-04-30 27 13 19
2020-05-01 51 48 66
2020-05-02 56 65 31
2020-05-03 37 41 15
2020-05-04 27 24 36
2020-05-05 23 23 11
2020-05-06 12 7 18
2020-05-07 7 8 8
2020-05-08 18 13 8
2020-05-09 18 13 5
2020-05-10 7 7 8
2020-05-11 7 4 4
2020-05-12 9 8 10
2020-05-13 5 5 0
2020-05-14 14 3 13
2020-05-15 3 3 3
2020-05-16 7 3 4
2020-05-17 3 0 2
2020-05-18 5 2 3
2020-05-19 1 3 1
2020-05-20 2 1 2
2020-05-21 6 3 2
2020-05-22 1 2 0
2020-05-23 1 1 0
2020-05-24 9 4 1
2020-05-25 5 1 2
2020-05-26 6 4 0
2020-05-27 6 2 3
2020-05-28 11 2 2
2020-05-29 11 6 4
2020-05-30 4 5 5
2020-05-31 4 1 0
2020-06-01 9 3 1
2020-06-02 15 8 11
2020-06-03 6 5 1
2020-06-04 23 3 2
2020-06-05 12 7 1
2020-06-06 19 6 1
2020-06-07 7 7 0
2020-06-08 11 2 0
2020-06-09 6 3 3
2020-06-10 12 4 2
2020-06-11 15 4 3
2020-06-12 21 3 1
2020-06-13 15 5 4
2020-06-14 38 6 3
2020-06-15 37 10 1
2020-06-16 23 2 2
2020-06-17 8 5 3
2020-06-18 28 10 3
2020-06-19 23 7 5
2020-06-20 33 6 0
2020-06-21 31 2 1
2020-06-22 21 8 0
2020-06-23 20 8 3
2020-06-24 42 12 1
2020-06-25 34 12 2
2020-06-26 42 12 0
2020-06-27 41 14 2
2020-06-28 46 12 2
2020-06-29 47 6 5
2020-06-30 33 17 4
2020-07-01 53 14 0
2020-07-02 76 23 8
2020-07-03 101 19 4
2020-07-04 106 20 5
2020-07-05 78 22 11
2020-07-06 75 26 1
2020-07-07 79 27 0
2020-07-08 58 17 0
2020-07-09 183 37 4
2020-07-10 195 43 5
2020-07-11 159 42 5
2020-07-12 154 40 12
2020-07-13 87 30 2
2020-07-14 106 33 4
2020-07-15 115 40 10
2020-07-16 210 66 10
2020-07-17 217 63 13
2020-07-18 202 71 17
2020-07-19 135 46 7
2020-07-20 111 48 9
2020-07-21 141 78 18
2020-07-22 161 65 12
2020-07-23 256 89 21
2020-07-24 192 61 7
2020-07-25 205 82 8
2020-07-26 152 63 24
2020-07-27 84 41 6
2020-07-28 181 71 14
2020-07-29 169 71 10
2020-07-30 247 96 24
2020-07-31 342 109 12
2020-08-01 348 110 14
2020-08-02 214 69 9
2020-08-03 182 63 13
2020-08-04 207 79 23
2020-08-05 181 71 11
2020-08-06 249 95 16
2020-08-07 325 120 17
2020-08-08 296 110 23
2020-08-09 227 82 22
2020-08-10 124 61 12
2020-08-11 130 48 10
2020-08-12 144 57 21
2020-08-13 123 69 14
2020-08-14 241 119 29
2020-08-15 230 124 31
2020-08-16 162 84 14
2020-08-17 87 57 17
2020-08-18 121 66 20
2020-08-19 115 58 13
2020-08-20 199 108 32
2020-08-21 156 85 17
2020-08-22 173 67 16
2020-08-23 119 76 17
2020-08-24 57 30 8
2020-08-25 94 70 18
2020-08-26 128 92 16
2020-08-27 158 69 23
2020-08-28 125 82 19
2020-08-29 134 92 21
Raw
tokyo_age3_weekly.csv
date weeks 30代以下 40-60代 70代以上
2020-01-19 2020-W04 1 1 0
2020-01-26 2020-W05 1 0 0
2020-02-02 2020-W06 0 0 0
2020-02-09 2020-W07 0 6 5
2020-02-16 2020-W08 3 7 5
2020-02-23 2020-W09 2 3 3
2020-03-01 2020-W10 7 10 10
2020-03-08 2020-W11 3 15 5
2020-03-15 2020-W12 11 34 4
2020-03-22 2020-W13 64 103 61
2020-03-29 2020-W14 231 234 72
2020-04-05 2020-W15 466 474 109
2020-04-12 2020-W16 390 498 212
2020-04-19 2020-W17 331 362 183
2020-04-26 2020-W18 234 227 198
2020-05-03 2020-W19 142 129 101
2020-05-10 2020-W20 52 33 42
2020-05-17 2020-W21 19 12 10
2020-05-24 2020-W22 52 24 17
2020-05-31 2020-W23 88 33 17
2020-06-07 2020-W24 87 28 13
2020-06-14 2020-W25 190 46 17
2020-06-21 2020-W26 231 68 9
2020-06-28 2020-W27 462 111 28
2020-07-05 2020-W28 827 214 26
2020-07-12 2020-W29 1091 343 68
2020-07-19 2020-W30 1201 469 82
2020-07-26 2020-W31 1523 561 104
2020-08-02 2020-W32 1654 607 112
2020-08-09 2020-W33 1219 560 139
2020-08-16 2020-W34 1013 525 129
2020-08-23 2020-W35 815 511 122
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.