戯言日記

Rの話だと思ったら唐突にサバゲーが混じってくる何か。

バーチャートレースで国内の感染状況を可視化

前回、偉そうなことを言いながらRで可視化したネタを書いたが、二番煎じだったことが分かった。
というか、外務省がやってた。

https://www.anzen.mofa.go.jp/covid19/country_count.html

既に更新されているので自分が書いた日のデータと比べるのは不可能だが、まぁ大体考えてたことと一致している状況なので一安心。
あと何番目に煎じようが自分にとっては一番目に煎じたものなので、細かいことは知ったこっちゃないってことで()。

という訳で、二番煎じは分かった上で懲りずにデータ解析。
今回はバーチャートレースでやってみる。

やり方はここを参考にした。ほぼ写経で進めていく。

blog.hoxo-m.com

ひとまずパッケージだけ入れておく。

library(tidyverse)
library(gganimate)
library(gifski)
library(rvest)

データを回収してきて、Excelでちゃちゃっといい感じの形にしてRに読み込む。
データの形としては一行目にID、二行目に時間軸のデータがあればいいようなので、最初からそれっぽい形にしておけばいい。
また、読み込む時に文字化けする場合は魔法の言葉を入れておく。Shift-JISに対応するためのものっぽい。

読み込んだら各都道府県を被験者数で順位付けする。
ランク関数はここを参考にした。row_number()とmin_rank()、denserank()は便利そうなので今後使っていきたい。

qiita.com

そのままアニメにすると縦軸が足りなくておかしな挙動を起こしたので、row_number()で順位付けしてから上位20位までを抽出して誤魔化すことにした。縦軸が足りるならmin_rank()を使う方がスマートだと思う。

また日付はas.POSIXct()で時間に変えておく。
こうすることでぬるぬる動くグラフにしやすい。

test <- readr::read_csv("~/test.csv", locale = locale(encoding = "cp932")) %>%
  dplyr::group_by(Date) %>%
  dplyr::mutate(Ranking = People %>% desc() %>% row_number()) %>%
  dplyr::ungroup() %>% 
  dplyr::filter(Ranking <= 20) %>% 
  dplyr::mutate(Date = Date %>% as.POSIXct())


## # A tibble: 605 x 4
##    Area     Date                People Ranking
##    <chr>    <dttm>               <dbl>   <int>
##  1 京都府   2020-02-06 00:00:00      2       1
##  2 千葉県   2020-02-06 00:00:00      1       2
##  3 神奈川県 2020-02-06 00:00:00      1       3
##  4 三重県   2020-02-06 00:00:00      1       4
##  5 大阪府   2020-02-06 00:00:00      1       5
##  6 奈良県   2020-02-06 00:00:00      1       6
##  7 京都府   2020-02-07 00:00:00      2       1
##  8 千葉県   2020-02-07 00:00:00      1       2
##  9 神奈川県 2020-02-07 00:00:00      1       3
## 10 三重県   2020-02-07 00:00:00      1       4
## # ... with 595 more rows


ここから作図。geom_barじゃなくてgeom_tileなのが肝らしい。

g <- test %>% ggplot(aes(x = Ranking, group = Area)) +
  geom_tile(aes(y = People/2, height = People, fill = Area, width = 0.9)) +
  geom_text(aes(y = 0, label = paste(Area, " "), vjust = -1, hjust = -0.1)) +
  geom_text(aes(y = People, label = paste0(" ", People), vjust = 1, hjust = 0)) +
  scale_x_reverse() +
  coord_flip() +
  theme_light() +
  transition_time(Date)

Anime <- animate(g, fps = 10, duration = 32, end_pause = 20, width = 800, height = 400)

出力する場合はこれでいい。

anim_save("race_bar_chart.gif", Anime)

gif画像が貼り付けられなくて絶望したから静止画だけとりあえず貼っておく。

f:id:doubtpad:20200318002634p:plain

各国のデータの可視化も有用そうだからやりたいけど、流石に拾ってくる元気がないため止めておく。
誰かExcelにデータ纏めてくれないですかね(適当)。