東京都のCOVID-19データを取ってくる(R版)

今日の東京都では366人の新規陽性者数が確認されましたね。今後どうなることやら。

catalog.data.metro.tokyo.lg.jp

統計を勉強している人は、生きているデータだとモチベーションが上がるし有用性もあるかもしれないから自分でもデータ分析してみよう、なんて考えるのではないでしょうか。すでに様々な人がプログラムを書いていると思いますが、遅ればせながら僕も東京都が公開しているデータを読み込んでグラフを書くプログラムを作ってみました。

# 東京都のサーバーからCSVを読み込む
dat_csv_url <- "https://stopcovid19.metro.tokyo.lg.jp/data/130001_tokyo_covid19_patients.csv"
dat <- read.csv(dat_csv_url, fileEncoding="UTF-8-BOM", header=TRUE, row.names=1)

# データのクリーニング
dat <- dat[, c(4, 7, 8, 9, 15)]
colnames(dat)<- c("公表日", "居住地", "年代", "性別", "退院済")
dat$公表日<- as.Date(dat$公表日, format="%Y-%m-%d")
dat$居住地 <- factor(dat$居住地)
dat$年代 <- factor(dat$年代)
dat[dat$年代=="'-",]$年代 <- "不明"   # 年代が '- となっているものを 不明 とする
dat$年代 <- ordered(dat$年代, levels=c("10歳未満", "10代", "20代", "30代", "40代",
                    "50代", "60代", "70代", "80代", "90代", "100歳以上", "不明"))
dat$性別 <- factor(dat$性別)
dat[dat$性別=="'-",]$性別 <- "不明"   # 性別が '- となっているものを 不明 とする
dat[dat$性別=="女",]$性別 <- "女性"   # 性別が 女 となっているものを 女性 とする
dat$性別 <- factor(dat$性別)
dat$退院済 <- factor(dat$退院済, levels=c(0, 1))
dat[is.na(dat$退院済),]$退院済 <- 0   # NAのデータは未退院(0)とする

以上でデータの整理ができました。データの概要を見るためにsummaryを使ってみます。

> summary(dat)
     公表日                    居住地          年代          性別      退院済  
 Min.   :2020-01-24               : 239   20代   :3096   女性  :4072   0:2868  
 1st Qu.:2020-04-16   湖南省長沙市:   1   30代   :2058   男性  :5974   1:7186  
 Median :2020-05-12   湖北省武漢市:   2   40代   :1381   調査中:   1           
 Mean   :2020-05-26   調査中      :  85   50代   :1146   不明  :   7           
 3rd Qu.:2020-07-11   都外        : 425   60代   : 725                         
 Max.   :2020-07-22   都内        :8965   70代   : 632                         
                      ―          : 337   (Other):1016     

居住地が空白になっているものとダッシュになっているものがありますが、不明にまとめてしまってしていいか分からないのでそのままにしています。

テレビなどでよく見る新規陽性者数の推移をプロットするのには以下のように、公表日ごとの人数を集計します。

# 新規陽性者数のグラフ
num.positive <- table(dat$公表日)
plot(num.positive, xlab="公表日", ylab="新規陽性者数")
grid()

ついでにN日間移動平均線を追加しましょう。以下ではN=7としています。

# N日間移動平均
npos <- as.data.frame(num.positive)
colnames(npos) <- c("公表日", "新規陽性者数")
N <- 7
npos$移動平均 <- filter(npos$新規陽性者数, rep(1,N)/N, sides=1)
lines(npos$公表日, npos$移動平均, col=2, lwd=2)

出てきたグラフは以下のようになりました(今日公開されているのは昨日までのデータなので366人の新規については入っていません)。CSVファイルで情報提供されていると、いろいろな人が試してみることができるのでいいですね。

f:id:amarui:20200723172059p:plain