tidyverseを駆使してRでコロナウィルス患者数の推移を棒グラフにしてみた
最近Rを触っていなかったので、復習がてら。
東洋経済のコロナ情報ページがバズっていたので、同じように日本のコロナウイルス患者数の推移のグラフを作ってみようかなと思いました。
グラフを作成した以外のことはやってません。悪しからず。
toyokeizai.net
tidyverseのパッケージ群を使ってデータ前処理から可視化までやってみました。
github.com
使用したデータ
データはこちらから引っ張ってきました。ジョンズ・ホプキンズ大学が公開しているようです。
国別・地域別の感染者数、回復者数、死亡者数のデータがcsvで取得できます。
また時系列ごとのデータと日ごとのデータにも分かれています。
※厚生労働省や各社メディアによる発表の数とは異なっている場合があります。
データ取得
library(tidyverse) library(lubridate) #累計患者数 time_series_confermed <- read_csv('~/time_series_19-covid-Confirmed.csv') #累計死亡者数 time_series_deaths <- read_csv('~/time_series_19-covid-Deaths.csv') #累計回復者数 time_series_recovered <- read_csv('~/time_series_19-covid-Recovered.csv')
データ前処理
取得したデータをみてみましょう。
time_series_confermed # A tibble: 442 x 57 `Province/State` `Country/Region` Lat Long `1/22/20` `1/23/20` `1/24/20` <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> 1 NA Thailand 15 101 2 3 5 2 NA Japan 36 138 2 1 2 3 NA Singapore 1.28 104. 0 1 3 4 NA Nepal 28.2 84.2 0 0 0 5 NA Malaysia 2.5 112. 0 0 0 6 British Columbia Canada 49.3 -123. 0 0 0 7 New South Wales Australia -33.9 151. 0 0 0 8 Victoria Australia -37.8 145. 0 0 0 9 Queensland Australia -28.0 153. 0 0 0 10 NA Cambodia 11.6 105. 0 0 0 # … with 432 more rows, and 50 more variables: `1/25/20` <dbl>, `1/26/20` <dbl>, # `1/27/20` <dbl>, `1/28/20` <dbl>, `1/29/20` <dbl>, `1/30/20` <dbl>, # `1/31/20` <dbl>, `2/1/20` <dbl>, `2/2/20` <dbl>, `2/3/20` <dbl>, `2/4/20` <dbl>, # `2/5/20` <dbl>, `2/6/20` <dbl>, `2/7/20` <dbl>, `2/8/20` <dbl>, `2/9/20` <dbl>, # `2/10/20` <dbl>, `2/11/20` <dbl>, `2/12/20` <dbl>, `2/13/20` <dbl>, # `2/14/20` <dbl>, `2/15/20` <dbl>, `2/16/20` <dbl>, `2/17/20` <dbl>, # `2/18/20` <dbl>, `2/19/20` <dbl>, `2/20/20` <dbl>, `2/21/20` <dbl>, # `2/22/20` <dbl>, `2/23/20` <dbl>, `2/24/20` <dbl>, `2/25/20` <dbl>, # `2/26/20` <dbl>, `2/27/20` <dbl>, `2/28/20` <dbl>, `2/29/20` <dbl>, `3/1/20` <dbl>, # `3/2/20` <dbl>, `3/3/20` <dbl>, `3/4/20` <dbl>, `3/5/20` <dbl>, `3/6/20` <dbl>, # `3/7/20` <dbl>, `3/8/20` <dbl>, `3/9/20` <dbl>, `3/10/20` <dbl>, `3/11/20` <dbl>, # `3/12/20` <dbl>, `3/13/20` <dbl>, `3/14/20` <dbl>
日付が列になっていて横長のデータになっています。tidyではありませんね。
これを縦長のデータに変換します。まずは累計患者数に絞ってデータを整形していきます。
confirmed <- time_series_confermed %>% filter(`Country/Region`==('Japan')) %>% #日本に絞る select(-Lat, -Long,-`Province/State`) %>% #不必要な列を除外 pivot_longer(c(-`Country/Region`), names_to = "日付", values_to = "累計患者数")
今まで縦長⇔横長の変換はgather()/spread()でやってました。
存在は知っていましたが、恥ずかしながらpivot_longer()/pivot_wider()をまともに使ったのは今回が初めてでした(爆)
なにこれ超便利じゃん。。
confirmed # A tibble: 53 x 3 `Country/Region` 日付 累計患者数 <chr> <chr> <dbl> 1 Japan 1/22/20 2 2 Japan 1/23/20 1 3 Japan 1/24/20 2 4 Japan 1/25/20 2 5 Japan 1/26/20 4 6 Japan 1/27/20 4 7 Japan 1/28/20 7 8 Japan 1/29/20 7 9 Japan 1/30/20 11 10 Japan 1/31/20 15
縦長のデータになりました。
次に可視化のために日付データの処理をします。
confirmed$日付 <- mdy(confirmed$日付) confirmed$日付 <- as.Date(confirmed$日付) #明らかに患者数がおかしいデータがあったので、正しいデータに修正 confirmed <- confirmed %>% mutate(累計患者数 = case_when(日付=='2020-01-23'~ 2, 日付!='2020-02-06'~累計患者数)) %>% mutate(累計患者数 = case_when(日付=='2020-02-06'~ 25, 日付!='2020-02-06'~累計患者数))
累計患者数のみの棒グラフ
それではまずは累計患者数のみで棒グラフを描いてみます。
confirmed %>% ggplot(aes(日付, 累計患者数))+ ggtitle('新型コロナウイルス患者数の推移（日本）') + scale_x_date(date_breaks = '5 days', date_labels = '%m/%d') + theme(axis.text.x = element_text(angle=30, hjust=1)) + geom_bar(stat = 'identity', fill='#fff494')+ theme_dark(base_family = "HiraKakuPro-W3")
こんなグラフができました。
次は、累計回復者数と累計死亡者数のデータも加えて積み上げ棒グラフを作ります。
前処理と結合
累計患者数の時と同様に整形をしてjoinします。
#累計回復者数 recovered <- time_series_recovered %>% filter(`Country/Region`==('Japan')) %>% select(-Lat, -Long,-`Province/State`) %>% pivot_longer(c(-`Country/Region`), names_to = "日付", values_to = "累計回復者数") recovered$日付 <- mdy(recovered$日付) recovered$日付 <- as.Date(recovered$日付) #累計死亡者数 deaths <- time_series_deaths %>% filter(`Country/Region`==('Japan')) %>% select(-Lat, -Long,-`Province/State`) %>% pivot_longer(c(-`Country/Region`), names_to = "日付", values_to = "累計死亡者数") deaths$日付 <- mdy(deaths$日付) deaths$日付 <- as.Date(deaths$日付) #累計患者数、累計回復者数、累計死亡者数をジョイン japan_covid <- confirmed %>% left_join(select(recovered, "日付", "累計回復者数"), by = "日付") %>% left_join(select(deaths, "日付","累計死亡者数"), by = "日付")
１つのデータフレームにまとまりました。
japan_covid # A tibble: 53 x 5 `Country/Region` 日付 累計患者数 累計回復者数 累計死亡者数 <chr> <date> <dbl> <dbl> <dbl> 1 Japan 2020-01-22 2 0 0 2 Japan 2020-01-23 2 0 0 3 Japan 2020-01-24 2 0 0 4 Japan 2020-01-25 2 0 0 5 Japan 2020-01-26 4 1 0 6 Japan 2020-01-27 4 1 0 7 Japan 2020-01-28 7 1 0 8 Japan 2020-01-29 7 1 0 9 Japan 2020-01-30 11 1 0 10 Japan 2020-01-31 15 1 0
積み上げ棒グラフの描画のためにさらに縦長のデータにします。
japan_covid <- japan_covid %>% pivot_longer(c(-`Country/Region`,-日付), names_to = "カテゴリ", values_to = "人数") japan_covid # A tibble: 159 x 4 `Country/Region` 日付 カテゴリ 人数 <chr> <date> <chr> <dbl> 1 Japan 2020-01-22 累計患者数 2 2 Japan 2020-01-22 累計回復者数 0 3 Japan 2020-01-22 累計死亡者数 0 4 Japan 2020-01-23 累計患者数 2 5 Japan 2020-01-23 累計回復者数 0 6 Japan 2020-01-23 累計死亡者数 0 7 Japan 2020-01-24 累計患者数 2 8 Japan 2020-01-24 累計回復者数 0 9 Japan 2020-01-24 累計死亡者数 0 10 Japan 2020-01-25 累計患者数 2 # … with 149 more rows
積み上げ棒グラフの描画
それでは描画してみましょう。
japan_covid %>% ggplot(aes(x=日付,y=人数,fill=factor(カテゴリ)))+ ggtitle('新型コロナウィルス患者数の推移（日本）')+ geom_bar(stat = 'identity', position = position_identity())+ scale_x_date(date_breaks = '5 days', date_labels = '%m/%d') + scale_fill_manual(values = c(累計患者数 = "#fff494", 累計回復者数 = "#00fa9a",累計死亡者数="#ff6347"), limits=c("累計患者数","累計回復者数","累計死亡者数"))+ theme_dark(base_family = "HiraKakuPro-W3")+ theme(legend.position = c(0.2,0.8), axis.text.x = element_text(angle=30, hjust=1), plot.title = element_text(face = "bold")) + guides(fill=guide_legend(title = NULL))
欲しかったグラフができました。（元々のデータが間違っているところがあるので100％正確ではないが）
やっぱりグラフの描画に関してはPythonよりRの方がやりやすいし好きな気がするなあ。。
tidyverse神。Hadley Wickham様神。
次の記事ではPythonで同じことをやってみたいと思います。
