KeepNotes blog

Stay hungry, Stay Foolish.

0%

R-交互式表格展示Covid-19数据

Posted on In ,
Symbols count in article: 6.5k Reading time ≈ 6 mins.

最近在陆陆续续收集一些可视化Covid-19数据的一些方法，主要想用R来实现；一方面对R比较熟悉，另一方面是作为后续整合到Shiny的前期准备工作，最终实现用Shiny平台来全面展示全球Covid-19的数据，类似做一个这样的网页：opsdashboard

前期已经整理好了一部分用plotly的可视化方法：COVID-19可视化-Plotly

我觉得还可以用表格来汇总数据，最好带有一些交互的功能，大致整理了下有以下几种R包可供选择：

  • DT, An R interface to the DataTables library
  • reactable, Interactive data tables for R, based on the React Table library and made with reactR
  • flextable, The flextable package provides a framework for easily create tables for reporting and publications
  • gt, Easily generate information-rich, publication-quality tables from R
  • rhandsontable, Handsontable is a data grid component with an Excel-like appearance

经过一定的尝试后，决定使用reactable包，以下均以其为例

数据准备

表格包含Covid-19确诊/死亡数据，数据来源于github开源项目（https://github.com/CSSEGISandData/COVID-19），下载并整合全球确诊和死亡数据，将每个国家mapping到各大洲中，增加各国国旗log的URL，最终生成data_all数据框

library(reactable)
library(dplyr)
library(tidyr)
library(countrycode)
library(htmltools)

# Covid19 data url
url <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/"
url_comfirmed_global <- paste0(url, "time_series_covid19_confirmed_global.csv")
url_death_global <- paste0(url, "time_series_covid19_deaths_global.csv")

# Comfirmed data in global
data <- data.table::fread(url_comfirmed_global) %>%
  rename(Province_State = `Province/State`, Country_Region = `Country/Region`) %>%
  group_by(Country_Region) %>%
  summarise_at((5 - 1):(ncol(.) - 1), sum)

# New comfirmed case in global
data_newcase <- plyr::ddply(data, "Country_Region", function(x) {
  diff(c(0, as.numeric(x[2:ncol(x)])))
})
names(data_newcase)[2:ncol(data_newcase)] <- colnames(data)[2:ncol(data)]

# Country and continent codes list
cty2ctt <- data.table::fread("https://pkgstore.datahub.io/JohnSnowLabs/country-and-continent-codes-list/country-and-continent-codes-list-csv_csv/data/b7876b7f496677669644f3d1069d3121/country-and-continent-codes-list-csv_csv.csv") %>%
  distinct(Country_Number, .keep_all = T)

# Death data in global
death_df <- data.table::fread(url_death_global) %>%
  rename(Province_State = `Province/State`, Country_Region = `Country/Region`) %>%
  group_by(Country_Region) %>%
  summarise_at((5 - 1):(ncol(.) - 1), sum)

# New death case in global
data_newdeath <- plyr::ddply(death_df, "Country_Region", function(x) {
  diff(c(0, as.numeric(x[2:ncol(x)])))
})
names(data_newdeath)[2:ncol(data_newdeath)] <- colnames(death_df)[2:ncol(death_df)]

# Combined comfirmed and death data in global
data_all <- left_join(gather(data, "year", "comfirm", colnames(data)[2:ncol(data)]),
                      gather(data_newcase, "year", "newcase", colnames(data_newcase)[2:ncol(data_newcase)])) %>%
  left_join(gather(data_newdeath, "year", "death", colnames(data_newdeath)[2:ncol(data_newdeath)])) %>%
  mutate(Code = countrycode(Country_Region, origin = "country.name", destination = "iso2c"),
         URL = paste0("https://www.countryflags.io/", tolower(Code), "/flat/64.png")) %>%
  left_join(cty2ctt, by = c("Code" = "Two_Letter_Country_Code")) %>%
  filter(!is.na(Continent_Name))

在绘制表格前，需要按照reactable包的教程将数据做一定的转化，以符合后续函数的要求

dt <- data_all[,c(1:8)] %>%
  group_by(Country_Region) %>%
  summarise(
    comfirm = list(comfirm), 
    newcase = list(newcase), 
    death = list(death),
    Continent_Name = unique(Continent_Name),
    URL = unique(URL),
    Total_comfirm = max(unlist(comfirm)),
    Total_death = sum(unlist(death)),
    Latest_newcase = tail(unlist(newcase), 1),
    Latest_death = tail(unlist(death), 1),
    newcase7days = if_else(is.na(lm(1:7 ~ tail(unlist(newcase), 7))$coefficients[2]), "Down",
                           if_else(lm(1:7 ~ tail(unlist(newcase), 7))$coefficients[2] > 0, "Up", "Down")),
    death7days = if_else(is.na(lm(1:7 ~ tail(unlist(death), 7))$coefficients[2]), "Down",
                         if_else(lm(1:7 ~ tail(unlist(death), 7))$coefficients[2] > 0, "Up", "Down"))
  )

通过对reactable包的reactable函数参数的选择，我们可以生成多样的可交互式表格，比如

reactable(
  dt[,c(1,5,7,9,8,10)], groupBy = "Continent_Name", filterable = TRUE, 
  defaultSorted = list("Total_comfirm" = "desc"), searchable = TRUE,
  borderless = TRUE, onClick = "expand",
  columns = list(
    Country_Region = colDef(
      cell = function(value, index){
        image <- img(src = dt[["URL"]][index], height = "24px", alt = "")
        tags$div(
          style = c("display:flex", "align-items: center"),
          div(image, style = "margin-right:5px"),
          value
        )
      }),
    Total_comfirm = colDef(name = "Total_comfirm", aggregate = "sum"),
    Total_death = colDef(name = "Total_death", aggregate = "sum"),
    Latest_newcase = colDef(name = "Latest_newcase", aggregate = "sum"),
    Latest_death = colDef(name = "Latest_death", aggregate = "sum")
  )
)

结果如下所示，首先展示的是各大洲的疫情数据，然后点击某个大洲后，可展示出所属该洲下所有国家的确诊/死亡数据，Total代表汇总数据，Latest代表最新当天新增数据，可能数据上会有点延迟，毕竟是开源数据来源：

接着我想通过reactable函数在表格中加入简单的图片，以用于展示数据变化趋势，比如折线图以及柱状图等等

reactable(
  dt[,c(1,7,2,9,3,11,8,10,4,12)], defaultPageSize = 15, #filterable = TRUE, 
  defaultSorted = list("Total_comfirm" = "desc"), searchable = TRUE,
  borderless = TRUE, onClick = "expand", #rowStyle = list(cursor = "pointer"),
  defaultColDef = colDef(
    align = "center"
  ),
  columns = list(
    Country_Region = colDef(cell = function(value, index){
      image <- img(src = dt[["URL"]][index], height = "24px", alt = "")
      tags$div(
        style = c("display:flex", "align-items: center"),
        div(image, style = "margin-right:5px"),
        value
      )
    }),
    comfirm = colDef(name = "Comfirm_Trend", cell = function(value, index) {
      sparkline(dt$comfirm[[index]])
    }),
    newcase = colDef(name = "Newcase_Trend", cell = function(values, index) {
      sparkline(dt$newcase[[index]], type = "bar", chartRangeMin = 0)
    }),
    death = colDef(name = "Death_Trend", cell = function(values, index) {
      sparkline(dt$death[[index]], type = "bar", chartRangeMin = 0)
    }),
    newcase7days = colDef(
      name = "Newcase_Trend(7days)",
      style = function(value) {
        if (value == "Up") {
          color <- "#e00000"
        } else {
          color <- "#008000"
        }
        list(color = color, fontWeight = "bold")
      }
    ),
    death7days = colDef(
      name = "Death_Trend(7days)",
      style = function(value) {
        if (value == "Up") {
          color <- "#e00000"
        } else {
          color <- "#008000"
        }
        list(color = color, fontWeight = "bold")
      }
    )
  )
)

结果如下所示，在第一张的基础上增加了每日确诊/死亡的趋势图，以及最近7天的线性拟合结果（简单的处理，斜率大于0则为Up，反之则为Down）：

reactable函数其他更加详细的参数可参照其Examples和Demos

参考资料

https://leonawicz.github.io/HtmlWidgetExamples/ex_dt_sparkline.html
https://github.com/htmlwidgets/sparkline
https://glin.github.io/reactable/
https://github.com/nanxstats/awesome-shiny-extensions

本文出自于http://www.bioinfo-scrounger.com转载请注明出处

Related Posts