|
|
|
2020.05.30
テーマ：パソコンを楽しむ♪(3523)
カテゴリ：データ分析
ECDCのデータを利用して、国ごとの実効再生産数・Rtを計算するR言語のコードの改訂版です。
R言語のコードで、前処理、計算したデータをcsvファイルに保存し、グーグルのスプレッドシートにインポートして、そのスプレッドシートをグーグルのデータポータル・ダッシュボードのデータソースにしています。 計算した実効再生産数・RtをECDCのデータを利用したダッシュボードでグラフ化しています。プルダウンメニューで国を選んで、グラフを表示させることができます。  下記のRコードで用いている「EpiEstim」のパッケージは、「Improved inference of time-varying reproduction numbers during infectious disease outbreaks」という論文に基づいています。 このパッケージでは、実効再生産数・Rtを日々の感染確認者数のデータと発症間隔のパラメータから計算しています。 ↓「EpiEstim」パッケージでは、発症間隔の分布の情報と日々の感染者のデータから実効再生産数・Rtを計算する仕組みになっています。ベイジアンの手法が用いられています。  なお、ジョンズ・ホプキンス大学のデータを利用したダッシュボードにも同じ計算方法での実効再生産数・Rtのページを追加していますが、ECDC版のデータと少し異なるので、実効再生産数・Rtの値も異なっています。 ------------------------------------------------------------------------------------ 【改訂版：Rコードの例】 ECDCのデータでは、スペインの最新の日付のデータが欠損しています。データの日付がそろっていないと、ダッシュボード的に不便なので、最新の日付のスペインの「ゼロ」データを１行追加しています。この場合、「today」の日付を利用しているので、スペイン以外の国のデータとの整合性の関係上、下記のコードでのデータの読み込みは、日本時間の午前中に行う必要があるようです。夕方になると、スペイン以外の国のデータで「today」の日付のものが入ってくるようです。そうなると、やはりスペインのデータは一日分欠損状態になってしまいます。 なお、スペインの実効再生産数の計算にとってはよくないことなので、ECDCでデータ版のダッシュボードの実効再生産数ではスペインを選択できないようにしました。 代わりにスペインの実効再生産数・Rt（１日前までのデータでの計算結果）のページを追加しました。 ・Rtの計算結果のデータに年月日の列を追加しています。計算対象の国は、感染確認者数のデータのある日数が「70日以上」の国にしています。 ・感染確認者数のデータの「df_DC」の処理の部分は、「df_ECDC」のデータを利用すればいいので、この部分を除けばもっとコードの行数を減らすことができます。 ・発病間隔のパラメータを平均4.8、標準偏差2.3にしています 【修正】EpiEstimの推定のところで、「df_ECDCtemp2$cases」が文字列になっていたので、エラーになっていました。as.numeric(df_ECDCtemp2$cases)と応急処置しました。以前は、スペインの１行をスプレッドシートで作成したものを、csvファイルにして、読み込んで、本体と結合していました。改訂版のコードでは、コード上でスペインの１行を作成するようにしたので、変数のデータ型の問題が生じたようです。 →次の処理を加えて、データ型の問題を解消しました。一度、csvファイルに書き出し、読み込むとデータ型の問題が解消しました。 read.csv()によってデータ型が変換されます。自動変換が合っている場合は、列ごとにデータ型を指定するよりも簡単なようです。今回のエラーとは関係がありませんが、「,stringsAsFactors = FALSE」の意味がよくわかります。 従って、「as.numeric(df_ECDCtemp2$cases)」の処理は不要になっています。 「write.csv(df_Spain,"df_Spain_temp.csv",fileEncoding = "UTF8") df_Spain <- read.csv("df_Spain_temp.csv",stringsAsFactors = FALSE) df_Spain <- df_Spain[,c(2:12)]」 ------------------------------------------------------ library(EpiEstim) df_ECDC <- NULL df_Spain <- NULL df_ECDC <-read.csv("https://opendata.ecdc.europa.eu/covid19/casedistribution/csv", na.strings = "", fileEncoding = "UTF-8-BOM",stringsAsFactors = FALSE) ＃ECDCの最新データは日付が１日前のものになるので、１日前の日付のスペインのデータを自動追加できるように、日付から、月と日の数字を取り出して利用します。 yestd <- today() - 1 mnum <- month(yestd) dnum <- day(yestd) ＃6月19日：人口データが更新されていました。変数名を"popData2019"に更新。 ＃スペインの人口も更新しました。 df_Spain <- t(c(paste0(dnum,"/0",mnum,"/2020"),dnum,mnum,"2020","0","0","Spain","ES","ESP","46937060","Europe")) colnames(df_Spain) <- c("dateRep","day","month","year","cases","deaths","countriesAndTerritories","geoId","countryterritoryCode","popData2019","continentExp") write.csv(df_Spain,"df_Spain_temp.csv",fileEncoding = "UTF8") df_Spain <- read.csv("df_Spain_temp.csv",stringsAsFactors = FALSE) df_Spain <- df_Spain[,c(2:12)] df_ECDC <- rbind(df_ECDC,df_Spain) colnames(df_ECDC) <- c("dateRep","day","month","year","cases","deaths","countriesAndTerritories","geoId","ISO code","popData2019","continentExp") -------------------------------------------------------------df_ECDC$Date <- as.Date(df_ECDC$dateRep,format="%d/%m/%Y") geo_list <- unique(df_ECDC$countriesAndTerritories) df_ECDCtemp <- NULL df_ECDCtemp1 <- NULL df_ECDCtemp2 <- NULL temp_R <- NULL temp_Rt <- NULL temp_date <- NULL temp_Date1 <- NULL temp_Case <- NULL temp_DC <- NULL df_DC <- NULL df_Rt <- NULL temp_notcal <- NULL Numa <- NULL Numb <- NULL Numc <- NULL df_notcal <- NULL df_ECDCtemp <- df_ECDC for (i in seq_along(geo_list)) { df_ECDCtemp1 <- subset(df_ECDCtemp,df_ECDCtemp$countriesAndTerritories==geo_list[i]) df_ECDCtemp2 <- subset(df_ECDCtemp1,df_ECDCtemp1$cases >= 0) if (length(df_ECDCtemp2$cases) >= 70) {rt_parametric_si <- estimate_R(as.numeric(df_ECDCtemp2$cases),method = "parametric_si",config = make_config(list(mean_si = 4.8,std_si = 2.3))) temp_R <- rt_parametric_si$R temp_Rt <- mutate(temp_R,countriesAndTerritories=geo_list[i]) Numa <- nrow(rt_parametric_si$R) temp_date <- as.data.frame(df_ECDCtemp1$Date) Numb <- nrow(temp_date) Numc <- Numb-Numa temp_date <- temp_date[-c(1:Numc),] temp_Rt <- mutate(temp_Rt,Days=seq(from=1,to=nrow(rt_parametric_si$R), by=1)) temp_Rt <- mutate(temp_Rt,Date=temp_date) temp_Date1 <- matrix(rt_parametric_si$dates,ncol=1) colnames(temp_Date1) <- "Days" temp_Case <- matrix(rt_parametric_si$I,ncol=1) colnames(temp_Case) <- "Cases" temp_DC <- cbind(temp_Date1,temp_Case) temp_DC <- as.data.frame(temp_DC) temp_DC <- mutate(temp_DC,countriesAndTerritories=geo_list[i]) df_DC <- rbind(df_DC,temp_DC) df_Rt <- rbind(df_Rt,temp_Rt)} else {temp_notcal <- as.data.frame(geo_list[i]) temp_notcal <- mutate(temp_notcal,Under70days=nrow(df_ECDCtemp1)) colnames(temp_notcal) <- c("countriesAndTerritories","Under70days") df_notcal <- rbind(df_notcal,temp_notcal) } } write.csv(df_Rt,paste0("Covid19datasetRt",mnum,dnum,".csv"),fileEncoding = "UTF8") write.csv(df_DC,paste0("Covid19datasetDC",mnum,dnum,".csv"),fileEncoding = "UTF8") ＃Rtを計算した国の数を確認します。170の国・地域の実効再生産数・Rtを計算していました。 geo_list <- unique(df_Rt$countriesAndTerritories) length(geo_list) ------------------------------------------------------------------------------------   -------------------------------------------------------------------------- ↓実効再生産数を計算できるWebアプリがあります。  ↓倍加時間についてです。  --------------------------------------------------------------------------  ------------------------------------------------------------------------- 【ダッシュボード「COVID-19 Transition Graphs」を試作】 中国本土以外の地域への感染が拡大しているため、国別、地域別の感染者数の推移を簡単に確認できるダッシュボードを試作しています。 随時、ページを追加しています。グラフのデータは、右上部分の操作でダウンロードすることができます。 アメリカの「地域別の変数」を前処理して、「州別」での推移をグラフ化できるようにしました。 また、州コードのフィールドを作成してコロプレス地図も作成しています。 楽天ブログでは「iframe」タグが使えないので、Bloggerのページから利用できるようにしています。 無料で利用できる、グーグルの「データポータル」のダッシュボードです。データさえあれば、簡単に作成できます。「国」別、「地域」別に日ごとの感染者数の推移を見ることができます。 ↓ダッシュボードの試作です。下記リンクのページから利用できます。  ジョンズ・ホプキンス大学の「JHU CSSE」の「Covid19 Daily Reports」のデータを利用しています。 EdgeブラウザやIEブラウザなど、Chromeブラウザ以外での利用の場合はうまく表示されないことがあるようです。 新型コロナウイルス（2019-novel coronavirus）対策もインフルエンザ対策と同じで、手洗い、うがい、マスク着用（咳エチケット）、免疫力アップなどが対策になるようです。↓上記のダッシュボードのデータの出所のサイトです。マップがメインのダッシュボードです  ----------------------------------------------------------------------------------------- ↓WHOのサイトでも、感染者数、地域などの「Situation Report」が日々更新されています。関心がある場合は、一日に一度見るといいのではないかと思います。   ↓日本のインフルエンザの「定点当たり報告数」をグラフ化できるダッシュボードを試作。都道府県別にグラフ化可能です。  ------------------------------------------------------ ---------------------------------------------------------------------------- ★おすすめの記事     ◆How Windows Sonic looks like.：Windows Sonic for Headphonesの音声と２chステレオ音声の比較：7.1.2chテストトーンの比較で明らかになった違い：一目で違いがわかりました  ---------------------------------------------------------------------------------------------------------- お気に入りの記事を「いいね！」で応援しよう
Last updated
2020.06.20 01:28:54
コメント(0) | コメントを書く
[データ分析] カテゴリの最新記事
|
|
![[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]](https://hbb.afl.rakuten.co.jp/hgb/1aae7a85.f4143c83.1aae7a86.7dc201df/?me_id=1210867&item_id=10054198&m=https%3A%2F%2Fthumbnail.image.rakuten.co.jp%2F%400_gold%2Fgoodlifeshop%2Fgcabi%2Fbct%2F4903320575981.gif%3F_ex%3D80x80&pc=https%3A%2F%2Fthumbnail.image.rakuten.co.jp%2F%400_gold%2Fgoodlifeshop%2Fgcabi%2Fbct%2F4903320575981.gif%3F_ex%3D240x240&s=240x240&t=picttext "[商品価格に関しましては、リンクが作成された時点と現時点で情報が変更されている場合がございます。]")
