◆【２月５日更新版】新型コロナウイルス感染者総数の日ごとの推移のグラフを作成する「R」のコード例

↓動画ファイル版です

↓アニメーションGIF版です

グラフのデータは、Kaggleの「Novel Corona Virus 2019 Dataset」のcsvファイルに基づいています。

新しいデータファイルには、「Date」という変数が付加されて、日付別の集計がしやすくなりました。データファイル作成者に感謝します。

データのバージョン6では、「Date」の変数の日付データの形がすべて統一されていて、前処理が簡単になりました。

＜Rのコードの例：gganimateなどのパッケージを利用しています。＞

df_cov <- read.csv("2019_nCoV_data0205.csv")

df_cov <- df_cov %>% tidyr::separate(Date, c("Date1","time"), " ",convert = TRUE)

view(df_cov)

df_cov$Date1 <- as.Date(df_cov$Date1,format="%m/%d/%Y")

df_cov_date <- df_cov %>%  group_by(Date1) %>% summarise(Conf = sum(Confirmed))

df_cov_date<- mutate(df_cov_date,Val_lbl = paste0(" ",Conf))

view(df_cov_date)

gra <- ggplot(df_cov_date, aes(x = Date1, y = Conf)) + geom_bar(stat = "identity",fill = "darkred") +
  geom_text(aes(y=Conf,label = Val_lbl,vjust =-0.25, hjust=0.5),size = 5.25 ) +
  labs(x="Date",y="Confirmed Cases",title="Confirmed cases of 2019-nCoV",caption="Data source:
       https://www.kaggle.com/sudalairajkumar/novel-corona-virus-2019-dataset/data")

gra <- gra + theme(axis.line=element_blank(),
        axis.text.x=element_text(colour="black", size=12),
        axis.text.y=element_text(colour="black", size=12),
        axis.ticks=element_blank(),
        axis.title.x=element_text(colour="black", size=14),
        axis.title.y=element_text(colour="black", size=14),
        legend.position="none",
        panel.background=element_blank(),
        panel.border=element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major.x =element_blank(),
        panel.grid.minor.x =element_blank(),
        panel.grid.major.y = element_line( size=.2, color="grey" ),
        panel.grid.minor.y = element_line( size=.2, color="grey" ),
        plot.title=element_text(size=20, hjust=0.5, face="bold", colour="black", vjust=-1),
        plot.subtitle=element_text(size=16, hjust=0.5, face="italic", color="black"),
        plot.caption =element_text(size=9, hjust=1, face="italic", color="black"),
        plot.background=element_blank(),
        plot.margin = margin(0.5,0.5, 0.5, 0.5, "cm"))

plot(gra)

gra <- gra + transition_states(Date1, transition_length = 4, state_length = 1) +
  shadow_mark() + enter_grow() + enter_fade()

animate(gra, nframes = 200,fps = 15,start_pause = 20,duration = 20, width = 740, height = 520,renderer = gifski_renderer("ncov0205.gif"))

------------------------------------------------------------------------------

-------------------------------------------------------------------------------

--------------------------------------------------------------------------------

--------------------------------------------------------------------------------

◆【COVID-19】国別、地域別の感染者数の推移を簡単に確認できる「DashBoard（ダッシュボード）」の試作です：新型コロナウイルスダッシュボード（Novel Coronavirus DashBoard）

【COVID-19】今後、中国本土以外の地域への感染拡大が懸念されているため、国別、地域別の感染者数の推移を簡単に確認できるダッシュボードを試作してみました(Data source : JHU CSSE Covid19 Daily Reports)。

◆【更新版】新型コロナウイルス感染者総数の日ごとの推移のグラフを作成する「R」のコード例

グラフのデータは、Kaggleの「Novel Corona Virus 2019 Dataset」のcsvファイルに基づいています。

新しいデータファイルには、「Date」という変数が付加されて、日付別の集計がしやすくなりました。

ただし、498行目以降の追加データの日付の形が「"%Y/%d/%m"」と、元々の日付の形「"%m/%d/%Y"」ではなかったり、元々あるデータの日付の一部の「年」が４桁でなくて、２桁だったりしました。２桁の年を４桁にするのは、Excelのシートで手作業で処理してしまいましたが、形が異なる元のデータ行と追加データ行の日付データを処理するのは、コードで行っています。

最初、「as.Date(df_cov2$Date1,format="%Y/%d/%m")」のところで、「％Y」を「％ｙ」というようにYを小文字にしていてうまく動かず、はまってしまいました。日付の変数は、扱いが面倒だと思います。

＜Rのコードの例：gganimateなどのパッケージを利用しています。＞

df_cov <- read.csv("2019_nCoV_data0203.csv")

df_cov <- df_cov %>% tidyr::separate(Date, c("Date1","time"), " ",convert = TRUE)

view(df_cov)

df_cov1 <- df_cov %>% filter(Sno <= 497)
df_cov2 <- df_cov %>% filter(Sno >= 498)

df_cov1$Date1 <- as.Date(df_cov1$Date1,format="%m/%d/%Y")
df_cov2$Date1 <- as.Date(df_cov2$Date1,format="%Y/%d/%m")

df_cov3 <- rbind(df_cov1,df_cov2)

view(df_cov3)

df_cov_date <- df_cov3 %>%  group_by(Date1) %>% summarise(Conf = sum(Confirmed))

df_cov_date<- mutate(df_cov_date,Val_lbl = paste0(" ",Conf))

view(df_cov_date)

gra <- ggplot(df_cov_date, aes(x = Date1, y = Conf)) + geom_bar(stat = "identity",fill = "darkred") +
  geom_text(aes(y=Conf,label = Val_lbl,vjust =-0.25, hjust=0.5),size = 5.25 ) +
  labs(x="Date",y="Confirmed Cases",title="Confirmed cases of 2019-nCoV",caption="Data source:
       https://www.kaggle.com/sudalairajkumar/novel-corona-virus-2019-dataset/data")

gra <- gra + theme(axis.line=element_blank(),
        axis.text.x=element_text(colour="black", size=12),
        axis.text.y=element_text(colour="black", size=12),
        axis.ticks=element_blank(),
        axis.title.x=element_text(colour="black", size=14),
        axis.title.y=element_text(colour="black", size=14),
        legend.position="none",
        panel.background=element_blank(),
        panel.border=element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major.x =element_blank(),
        panel.grid.minor.x =element_blank(),
        panel.grid.major.y = element_line( size=.2, color="grey" ),
        panel.grid.minor.y = element_line( size=.2, color="grey" ),
        plot.title=element_text(size=20, hjust=0.5, face="bold", colour="black", vjust=-1),
        plot.subtitle=element_text(size=16, hjust=0.5, face="italic", color="black"),
        plot.caption =element_text(size=9, hjust=1, face="italic", color="black"),
        plot.background=element_blank(),
        plot.margin = margin(0.5,0.5, 0.5, 0.5, "cm"))

plot(gra)

gra <- gra + transition_states(Date1, transition_length = 4, state_length = 1) +
  shadow_mark() + enter_grow() + enter_fade()

animate(gra, nframes = 200,fps = 15,start_pause = 20,duration = 20, width = 740, height = 520,renderer = gifski_renderer("ncov2.gif"))

----------------------------------------------------

---------------------------------------------------
-

◆新型コロナウイルス感染者の日ごとの推移のグラフを作成する「R」のコード例

グラフのデータは、Kaggleの「Novel Corona Virus 2019 Dataset」のcsvファイルに、「JJohns Hopkins university」のダッシュボードの最新データを追加したものです。KaggleのデータもJohns Hopkins universityのデータに基づいているようです。

「JJohns Hopkins university」のダッシュボードの最新データは、最新の日付が混在しているため、日別の集計にとっては、WHOの日報のデータを加工した方がよさそうです。

＜Rのコードの例：gganimateなどのパッケージを利用しています。＞

日別のデータにするために、便宜的に2月２日の日付を２月１日に置き換える処理をしています。

df_cov <- read.csv("2019_nCoV.csv")

df_cov <- df_cov %>% tidyr::separate(Last_Update, c("Last_Update1","time1"), " ", convert = TRUE)

df_cov$date1 <- lapply(df_cov$Last_Update1, gsub, pattern="2/2/2020", replacement = "2/1/2020")

df_cov$date1 <- as.Date(as.character(df_cov$date1),format="%m/%d/%y")

view(df_cov)

df_cov_date <- df_cov %>%  group_by(date1) %>% summarise(Conf = sum(Confirmed))

view(df_cov_date)

gra <- ggplot(df_cov_date, aes(x = date1, y = Conf)) + geom_bar(stat = "identity") + labs(x="Date",y="Confirmed Cases",title="Confirmed cases of 2019-nCoV")

plot(gra)

gra <- gra + transition_states(date1, transition_length = 4, state_length = 1) +

  shadow_mark() + enter_grow() + enter_fade()  

animate(gra, nframes = 200,fps = 15,start_pause = 20,duration = 20, width = 740, height = 520,renderer = gifski_renderer("ncov.gif"))

◆【更新版】新型コロナウイルス感染者の日ごとの推移のグラフを作成する「R」のコード例 ----------------------------------------------------

---------------------------------------------------
-

◆バーチャート・レースを作成する「R」コードの例です：プロ野球の球団別年間入場者数推移の場合

　日本野球機構が公表している、球団別年間入場者数データを用いて、バーチャート・レース（レーシング・バーチャート）の動画ファイルを作成する「R」のコードの一例です。「gganimate」を利用する方法です。

　やはり、データの前処理が重要ですが、「R」のコードは繰り返し作業に適していて、便利だと思います。

　コード化しておけば、処理を再現することが簡単・確実で、データ更新に即時に対応できます。また、コードは応用できるので、他のデータでのファイル作成に役立てることができます。

「R」コードで作成した動画ファイルに、編集ソフトでタイトルを入力したり、BGMを付けたりして完成です。





＜データの前処理＞
df_cent <- read.csv("central.csv")
df_cent <- as.data.frame(df_cent)
view(df_cent)

df_paci <- read.csv("pacificl.csv")
df_paci <- as.data.frame(df_paci)
df_paci <- df_paci[2:8]
view(df_paci)

df_cepa <- cbind(df_cent,df_paci)
view(df_cepa)

df_cepa <- df_cepa %>% mutate(year = paste0(year_n,"年"))
df_cepatidy <- df_cepa %>% gather(key=team,numbers,2:14)
view(df_cepatidy)

df_ceparank <- df_cepatidy %>%  group_by(year_n) %>% mutate(rank = rank(- numbers ),  Val_lbl = paste0(" ",numbers)) %>% group_by(year_n) %>%  filter(rank <= 12)
view(df_ceparank)

＃折れ線グラフなどでの並び順を下記のコードで設定しています。棒グラフの色指定でも＃この並び順を利用しています。

df_ceparank$team <- factor(df_ceparank$team,levels=c("読売ジャイアンツ","東京ヤクルトスワローズ","横浜DeNAベイスターズ","中日ドラゴンズ","阪神タイガース","広島東洋カープ","北海道日本ハムファイターズ","埼玉西武ライオンズ","千葉ロッテマリーンズ","大阪近鉄バファローズ","オリックスバファローズ","福岡ソフトバンクホークス","東北楽天ゴールデンイーグルス"))

＜バーチャート・レースのグラフ作成＞
grarank <-ggplot(df_ceparank,aes(x = rank, group = team))+ geom_tile(aes(y=numbers/2,height = numbers,fill = team,width = 0.8)) + scale_fill_manual(values=c("#F97709","#ED1A3D","#094a8c","#002569","#FFE201","#FF0000","#02518c","#102961","#221815","red","#b08f32","#f9ca00","#85010f"))+
labs(y=" ",title="プロ野球　セ・パ両リーグの球団別年間入場者数（1952年～2019年）",caption="日本野球機構のデータから") +
 geom_text(x = -10, y = 2750000,aes(label = year), size = 32, col = "navy") + geom_text(aes(y = 0, label = paste(team, " ")), vjust = 0.5, hjust =1, size = 6.75,face="bold",color="black")+
 geom_text(aes(y=numbers,label = Val_lbl,vjust = 0.95,hjust=0),size = 5.25 ) + coord_flip(clip = "off", expand = TRUE) + scale_x_reverse() +  theme_light() +  theme(legend.position = 'none')

＃チーム名が長いので、図に収まるように、左側の余白を大きくします

grarank <- grarank + theme(axis.line=element_blank(),
        axis.text.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks=element_blank(),
        axis.title.x=element_text(colour="navy", size=18),
        axis.title.y=element_blank(),
        legend.position="none",
        panel.background=element_blank(),
        panel.border=element_blank(),
        panel.grid.major=element_blank(),
        panel.grid.minor=element_blank(),
        panel.grid.major.x = element_line( size=.1, color="grey" ),
        panel.grid.minor.x = element_line( size=.1, color="grey" ),
        plot.title=element_text(size=32, hjust=0.5, face="bold", colour="black", vjust=-1),
        plot.subtitle=element_text(size=14, hjust=0.5, face="italic", color="black"),
        plot.caption =element_text(size=24, hjust=0.5, face="italic", color="black"),
        plot.background=element_blank(),
        plot.margin = margin(0.5,0.25,0.5,7, "cm"))
plot(grarank)
grarank <- grarank + transition_states(year, transition_length = 4, state_length = 1) + ease_aes('sine-in-out') + enter_fade() +  exit_fade()

animate(grarank, nframes = 300,fps = 20,start_pause = 20,duration = 60, width = 740, height = 520,renderer = gifski_renderer("cepa2019.gif"))

animate(grarank,nframes = 400,fps = 20,start_pause = 20,duration = 65, width = 1280, height = 720,renderer = ffmpeg_renderer())
gganimate::anim_save("cepa.mp4", animation = last_animation())


＜折れ線グラフ作成＞
ggplot(df_ceparank, aes(x=year_n, y=numbers,shape=team,colour=team)) + geom_line(aes(colour=team))+
  geom_point() +labs(x="year：日本野球機構のデータから",y="年間入場者数",title="プロ野球　セ・パ両リーグの年間入場者数の推移（1952年～2019年）") +  theme(legend.position="right")

------------------------------------------------------------------------------

-------------------------------------------------------------------------------

-------------------------------------------------------------------------------

◆インフルエンザの流行が拡大：インフルエンザの都道府県別の定点当たり報告数の第46週から第52週までの推移（国立感染症研究所のデータから）：都道府県別の「コロプレスマップ」です

2019年第52週（12月23日～12月29日）の、インフルエンザの定点当たり報告数を国立感染症研究所が発表しています。

　第46週から第52週までの、都道府県別の「定点当たり報告数」を、色分け地図にしてみました。インフルエンザの流行が全国的に拡大していることがうかがえます。ただし、10道県では前週から減少しています。

　下記の地図はインフルエンザの「定点当たり報告数」を５段階で色分けしたもの（コロプレスマップ）です。

なお、最新の概況については、国立感染症研究所のこちらのページで報告されています。


↓インフルエンザの「定点当たり報告数」の19年第46週から第51週までの推移

※塗り分け地図作成の参考ページ：http://ds0.cc.yamaguchi-u.ac.jp/~fukuyo/r-map.html

　 都道府県別にインフルエンザの「定点あたり報告数」を地図上で塗り分けするにあたって、色分けの区切りの値の問題が生じます。グラフスケールの取り方の問題のような感じです。スケールの取り方によって、グラフの見やすさや印象は変わってきます。

　合理的で、一貫した基準がないと「恣意的」なものになってしまいます。

　国立感染症研究所のページの都道府県別マップは、「警報・注意報レベル」についてのものです。区切りの基準が一定なので、少ないときは全体的に色が少なく、一定水準を超えて多くなると全体が真っ赤になって、どこが特に多いのかがわからず、色分けの意味が薄れてしまいます。

　そこで、「定点あたり報告数」の塗り分けについては、区分を変動的なものにしてみようと思います。

　上の図の塗り分けは、「定点あたり報告数」についてのものですが、基準として、最新データの「報告数－1」の値について、４分位範囲を「Summary（）」で見て、4分位数を利用しています。以前のデータの塗り分けもその区分を用いて、さかのぼって変遷を見られるようにしています。「－１」とするのは、区分の「１」を意識してのものです。報告数が１を超えるかどうかが、流行期入りかどうかの基準になっているようなので、区分の「１」は固定とし、それ以上の部分を変動制にしています。

　なお、アニメーションGIFは、アニメGIF作成サイトを利用する方法もありますが、「ImageMagick」というアプリで作成しました。Windowsの場合、地図の画像を一つのフォルダにまとめて保存し、コマンドプロンプトで、そのフォルダ（ディレクトリ）に「ｃｄ」してから、「magick convert -delay 250 -loop 0 *.png animation.gif」といったコマンドで作成できます。

----------------------------------------------------------------------------

【国立感染症研究所の概況コメント】：毎週、上書きされているので、以下のようにちょっと保存しておこうと思います。

2019年　第52週 （12月23日～12月29日）　2020年1月8日現在
　2019年第52週の定点当たり報告数は23.24（患者報告数115,002）となり、前週の定点当たり報告数21.22より増加した。
　都道府県別では山口県(38.39)、秋田県(33.61)、大分県(30.78)、山形県(30.28)、愛知県(29.94)、長野県(29.17)、埼玉県(28.61)、宮城県(28.19)、鳥取県(27.62)、千葉県(27.00)、熊本県(26.04)、三重県(26.00)、鹿児島県(25.95)、福島県(25.80)、栃木県(25.67)、石川県(25.04)、宮崎県(24.97)、北海道 (24.82)の順となっている。37都府県で前週の定点当たり報告数より増加がみられ、10道県で前週の定点当たり報告数より減少がみられた。
　定点医療機関からの報告をもとに、定点以外を含む全国の医療機関をこの1週間に受診した患者数を推計すると約87.7万人（95％信頼区間83.3～92.2万人）となり、前週の推計値（約76.2万人）より増加した。年齢別では、0～4歳が約10.1万人、5～9歳が約18.9万人、10～14歳が約12.2万人、15～19歳が約4.0万人、20代が約5.8万人、30代が約8.9万人、40代が約12.4万人、50代が約7.2万人、60代が約4.3万人、70代以上が約4.0万人となっている。また、2019年第36週以降これまでの累積の推計受診者数は約314.8万人となった。
　全国で警報レベルを超えている保健所地域は151箇所（38都道府県）、注意報レベルを超えている保健所地域は352箇所（全47都道府県）であった。
　基幹定点からのインフルエンザ患者の入院報告数は1,419例であり、前週（1,194例）より増加した。全47都道府県から報告があり、年齢別では0歳（87例）、1～9歳（497例）、10代（101例）、20代（15例）、30代（33例）、40代（39例）、50代（63例）、60代（130例）、70代（191例）、80歳以上（263例）であった。
　国内のインフルエンザウイルスの検出状況をみると、直近の5週間（2019年第48～52週）ではAH1pdm09（97%）、AH3亜型（１%）、B型（1%）の順であった。
　詳細は国立感染症研究所ホームページ（https://www.niid.go.jp/niid/ja/flu-map.html）を参照されたい。

----------------------------------------------------

---------------------------------------------------
-

◆世界の人口の推移＜紀元前660年～2100年＞：国立社会保障・人口問題研究所のデータから作成したアニメーショングラフ

「世界の人口の推移＜紀元前660年～2100年＞」を、国立社会保障・人口問題研究所のデータからアニメーショングラフにしました。

　近代まで世界の人口はあまり増加していませんでしたが、産業革命の頃から増加傾向が強まり、20世紀、21世紀はまさに「人口爆発」の時代となっています。



----------------------------------------------------

---------------------------------------------------
-