├── .gitignore ├── LICENSE ├── .Rbuildignore ├── nCov2019.jpg ├── vignettes ├── Animations.png ├── dashboard.png ├── introduction.png └── nCov2019.Rmd ├── inst ├── local_storage │ ├── global_data.json.gz │ ├── lastest_data.json.gz │ ├── vaccine_data.json.gz │ ├── historical_data.json.gz │ └── therapeutics_data.json.gz ├── CITATION └── shinyapp │ └── app.R ├── man ├── get_latest_data.Rd ├── get_global_data.Rd ├── get_vaccine_data.Rd ├── get_history_data.Rd ├── get_nCov2019.Rd ├── get_therapeutics_data.Rd ├── load_nCov2019.Rd ├── dashboard.Rd ├── convert.Rd ├── query.Rd └── plot.Rd ├── R ├── print.R ├── open_dashboard.R ├── utilities.R ├── query.R └── plot.R ├── NAMESPACE ├── DESCRIPTION ├── Makefile ├── example.R └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: Bioinformatics Group @ SMU 3 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | example.R 2 | nCov2019.jpg 3 | Makefile 4 | README.md 5 | 6 | -------------------------------------------------------------------------------- /nCov2019.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/nCov2019.jpg -------------------------------------------------------------------------------- /vignettes/Animations.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/vignettes/Animations.png -------------------------------------------------------------------------------- /vignettes/dashboard.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/vignettes/dashboard.png -------------------------------------------------------------------------------- /vignettes/introduction.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/vignettes/introduction.png -------------------------------------------------------------------------------- /inst/local_storage/global_data.json.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/inst/local_storage/global_data.json.gz -------------------------------------------------------------------------------- /inst/local_storage/lastest_data.json.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/inst/local_storage/lastest_data.json.gz -------------------------------------------------------------------------------- /inst/local_storage/vaccine_data.json.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/inst/local_storage/vaccine_data.json.gz -------------------------------------------------------------------------------- /inst/local_storage/historical_data.json.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/inst/local_storage/historical_data.json.gz -------------------------------------------------------------------------------- /inst/local_storage/therapeutics_data.json.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/YuLab-SMU/nCov2019/HEAD/inst/local_storage/therapeutics_data.json.gz -------------------------------------------------------------------------------- /man/get_latest_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_latest_data} 4 | \alias{get_latest_data} 5 | \title{Query the latest data online} 6 | \usage{ 7 | get_latest_data() 8 | } 9 | \value{ 10 | A 'nCov2019' object 11 | } 12 | \description{ 13 | Query global latest statistic for all contries 14 | } 15 | \author{ 16 | Guangchuang Yu 17 | } 18 | -------------------------------------------------------------------------------- /man/get_global_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_global_data} 4 | \alias{get_global_data} 5 | \title{Query the global data online} 6 | \usage{ 7 | get_global_data() 8 | } 9 | \value{ 10 | A 'global_summary' object 11 | } 12 | \description{ 13 | Query the global data online 14 | } 15 | \examples{ 16 | \dontrun{ 17 | x <- get_global_data() 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /R/print.R: -------------------------------------------------------------------------------- 1 | ##' @method print nCov2019 2 | ##' @export 3 | print.nCov2019 <- function(x, ...) { 4 | cat("last update:", x$time, "\n") 5 | } 6 | 7 | ##' @method print nCov2019History 8 | ##' @export 9 | print.nCov2019History <- print.nCov2019 10 | 11 | ##' @method print vaccine_therapeutics 12 | ##' @export 13 | print.vaccine_therapeutics <- function(x, ...) { 14 | cat("Total Candidates Programs :", x$totalCandidates,"\n") 15 | } 16 | -------------------------------------------------------------------------------- /man/get_vaccine_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_vaccine_data} 4 | \alias{get_vaccine_data} 5 | \title{Query the vaccine info online} 6 | \usage{ 7 | get_vaccine_data() 8 | } 9 | \value{ 10 | A 'vaccine_therapeutics' object 11 | } 12 | \description{ 13 | Query the vaccine info online 14 | } 15 | \examples{ 16 | \dontrun{ 17 | x <- get_vaccine_data() 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /man/get_history_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_history_data} 4 | \alias{get_history_data} 5 | \title{Query the historical data online} 6 | \usage{ 7 | get_history_data() 8 | } 9 | \value{ 10 | A 'nCov2019History' object 11 | } 12 | \description{ 13 | Query the historical data online 14 | } 15 | \examples{ 16 | \dontrun{ 17 | x <- get_history_data() 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /man/get_nCov2019.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_nCov2019} 4 | \alias{get_nCov2019} 5 | \title{Query the latest data} 6 | \usage{ 7 | get_nCov2019() 8 | } 9 | \value{ 10 | The latest statistic data 11 | } 12 | \description{ 13 | Query the latest data online;deprecated, 14 | use get_latest_data() in the further. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | x <- get_nCov2019() 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /man/get_therapeutics_data.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{get_therapeutics_data} 4 | \alias{get_therapeutics_data} 5 | \title{Query the therapeutics info online} 6 | \usage{ 7 | get_therapeutics_data() 8 | } 9 | \value{ 10 | A 'vaccine_therapeutics' object 11 | } 12 | \description{ 13 | Query the therapeutics info online 14 | } 15 | \examples{ 16 | \dontrun{ 17 | x <- get_therapeutics_data() 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /man/load_nCov2019.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{load_nCov2019} 4 | \alias{load_nCov2019} 5 | \title{Query the latest data} 6 | \usage{ 7 | load_nCov2019() 8 | } 9 | \value{ 10 | The historical statistic data 11 | } 12 | \description{ 13 | Query the historical data online;deprecated, 14 | use load_nCov2019() in the further. 15 | } 16 | \examples{ 17 | \dontrun{ 18 | x <- load_nCov2019() 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /man/dashboard.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/open_dashboard.R 3 | \name{open_dashboard} 4 | \alias{open_dashboard} 5 | \alias{dashboard} 6 | \title{Shiny app} 7 | \usage{ 8 | open_dashboard() 9 | 10 | dashboard() 11 | } 12 | \value{ 13 | No return value, open shiny app 14 | } 15 | \description{ 16 | A dashboard app for nCov2019 package 17 | } 18 | \examples{ 19 | \dontrun{ 20 | dashboard() 21 | # or 22 | open_dashboard() 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /man/convert.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utilities.R 3 | \name{convert} 4 | \alias{convert} 5 | \title{convert} 6 | \usage{ 7 | convert(data) 8 | } 9 | \arguments{ 10 | \item{data}{users' own data, it should contain these 6 column: "country","province","date","cases","deaths","recovered".} 11 | } 12 | \value{ 13 | a 'nCov2019History' object 14 | } 15 | \description{ 16 | Convert users' own data into class of nCov2019History data. Then it could be used in nCov2019. 17 | } 18 | -------------------------------------------------------------------------------- /man/query.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{query} 4 | \alias{query} 5 | \title{Query COVID-19 related statistic data} 6 | \usage{ 7 | query() 8 | } 9 | \value{ 10 | result contains 5 types of data: 11 | \itemize{ 12 | \item global: The global overall summary statistic 13 | \item latest: The global latest statistic for all countries 14 | \item historical: The historical statistic for all countries 15 | \item vaccine: The current vaccine development progress 16 | \item therapeutics: The current therapeutics development progress 17 | } 18 | } 19 | \description{ 20 | The main function for query nCov2019 related statistic data, 21 | } 22 | \examples{ 23 | \dontrun{ 24 | res <- query() 25 | names(res) 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | citHeader("To cite nCov2019 in publications use:") 2 | 3 | 4 | bibentry( 5 | bibtype = "article", 6 | title = "nCov2019: an R package for studying the COVID-19 coronavirus pandemic.", 7 | author = c( 8 | person("Tianzhi", "Wu"), 9 | person("Erqiang", "Hu"), 10 | person("Xijin", "Ge"), 11 | person("Guangchuang", "Yu") 12 | ), 13 | year = "2021", 14 | journal = "PeerJ", 15 | volume = "9", 16 | issue = "", 17 | number = "", 18 | pages = "e11421", 19 | doi = "10.7717/peerj.11421", 20 | PMID = "", 21 | url = "", 22 | textVersion = paste("T Wu, E Hu, X Ge, G Yu.", 23 | "nCov2019: an R package for studying the COVID-19 coronavirus pandemic.", 24 | "PeerJ 2021, 9:e11421. doi: 10.7717/peerj.11421") 25 | 26 | ) 27 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method("[",nCov2019) 4 | S3method("[",nCov2019History) 5 | S3method("[",vaccine_therapeutics) 6 | S3method(plot,nCov2019) 7 | S3method(plot,nCov2019History) 8 | S3method(print,nCov2019) 9 | S3method(print,nCov2019History) 10 | S3method(print,vaccine_therapeutics) 11 | S3method(summary,global_summary) 12 | S3method(summary,vaccine_therapeutics) 13 | export(convert) 14 | export(dashboard) 15 | export(get_latest_data) 16 | export(get_nCov2019) 17 | export(load_nCov2019) 18 | export(open_dashboard) 19 | export(query) 20 | importFrom(downloader,download) 21 | importFrom(ggplot2,aes_) 22 | importFrom(ggplot2,aes_string) 23 | importFrom(ggplot2,coord_equal) 24 | importFrom(ggplot2,geom_map) 25 | importFrom(ggplot2,ggplot) 26 | importFrom(ggplot2,labs) 27 | importFrom(ggplot2,map_data) 28 | importFrom(ggplot2,theme_minimal) 29 | importFrom(ggplot2,xlab) 30 | importFrom(ggplot2,ylab) 31 | importFrom(stats,aggregate) 32 | importFrom(utils,download.file) 33 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: nCov2019 2 | Title: Exploring 'COVID'-19 Statistics 3 | Version: 0.4.6 4 | Authors@R: c( 5 | person("Guangchuang", "Yu", email = "guangchuangyu@gmail.com", 6 | role = c("cre", "aut", "cph"), comment = c(ORCID = "0000-0002-6485-8781")), 7 | person("Tianzhi", "Wu", email = "wutimze@gmail.com", role = "aut"), 8 | person("Erqiang", "Hu", email = "13766876214@163.com", role = "ctb"), 9 | person("Patrick", "Tung", email = "tung_patrick@yahoo.com", role = "ctb"), 10 | person("Xijin", "Ge", email = "Xijin.Ge@sdstate.edu", role = "ctb") 11 | ) 12 | Maintainer: Guangchuang Yu 13 | Description: Provides easy-to-use programming API to access real time and historical data of 'COVID'-19 cases, vaccine and therapeutics data, and a Shiny app to help users exploring the data. Fetching data using API provided by . 14 | Depends: R (>= 3.6.0) 15 | Imports: 16 | downloader, 17 | ggplot2, 18 | jsonlite, 19 | RColorBrewer 20 | Suggests: 21 | cowplot, 22 | dplyr, 23 | DT, 24 | ggplotify, 25 | grDevices, 26 | maps, 27 | magick, 28 | shiny, 29 | shinyBS, 30 | shinydashboard, 31 | shinycssloaders, 32 | remotes, 33 | utils, 34 | plotly, 35 | prettydoc, 36 | knitr, 37 | rmarkdown, 38 | reshape2, 39 | ggrepel, 40 | shadowtext, 41 | tidyr 42 | VignetteBuilder: knitr 43 | License: MIT + file LICENSE 44 | URL: https://github.com/YuLab-SMU/nCov2019 45 | Encoding: UTF-8 46 | RoxygenNote: 7.2.3 47 | NeedsCompilation: no 48 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) 2 | PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) 3 | PKGSRC := $(shell basename `pwd`) 4 | 5 | all: rd check clean 6 | 7 | alldocs: rd readme 8 | 9 | figure: 10 | Rscript -e 'source("example.R")' 11 | 12 | 13 | rd: 14 | Rscript -e 'library(methods); devtools::document()' 15 | # Rscript -e 'roxygen2::roxygenise(".")' 16 | 17 | readme: 18 | Rscript -e 'rmarkdown::render("README.Rmd", encoding="UTF-8")' 19 | 20 | build: 21 | cd ..;\ 22 | R CMD build $(PKGSRC) 23 | 24 | build2: 25 | cd ..;\ 26 | R CMD build --no-build-vignettes $(PKGSRC) 27 | 28 | install: 29 | cd ..;\ 30 | R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz 31 | 32 | check: rd build 33 | cd ..;\ 34 | Rscript -e "rcmdcheck::rcmdcheck('$(PKGNAME)_$(PKGVERS).tar.gz', args='--as-cran')" 35 | 36 | check2: rd build2 37 | cd ..;\ 38 | R CMD check --no-build-vignettes $(PKGNAME)_$(PKGVERS).tar.gz 39 | 40 | clean: 41 | cd ..;\ 42 | $(RM) -r $(PKGNAME).Rcheck/ 43 | 44 | giteeinit: 45 | git remote add gitee git@gitee.com:GuangchuangYu/$(PKGNAME).git;\ 46 | git fetch --all 47 | 48 | update: 49 | git fetch --all;\ 50 | git checkout master;\ 51 | git merge gitee/master;\ 52 | git merge origin/master 53 | 54 | push: 55 | git push gitee master;\ 56 | git push origin master 57 | 58 | deploy: gh 59 | git checkout gh-pages;\ 60 | git add .;\ 61 | git commit -m 'update vignette';\ 62 | git push -u origin gh-pages;\ 63 | git checkout master 64 | 65 | gh: 66 | cd vignettes;\ 67 | Rscript -e "rmarkdown::render('nCov2019.Rmd')";\ 68 | mv nCov2019.html ../.. ;\ 69 | cd ..;\ 70 | git checkout gh-pages;\ 71 | mv ../nCov2019.html index.html 72 | -------------------------------------------------------------------------------- /man/plot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot.R 3 | \name{plot.nCov2019} 4 | \alias{plot.nCov2019} 5 | \alias{plot.nCov2019History} 6 | \title{plot.nCov2019} 7 | \usage{ 8 | \method{plot}{nCov2019}( 9 | x, 10 | region = "Global", 11 | continuous_scale = FALSE, 12 | palette = "Reds", 13 | date = NULL, 14 | title = "COVID19", 15 | type = "cases", 16 | ... 17 | ) 18 | 19 | \method{plot}{nCov2019History}( 20 | x, 21 | region = "Global", 22 | continuous_scale = TRUE, 23 | palette = "Reds", 24 | date = NULL, 25 | from = NULL, 26 | to = NULL, 27 | width = 600, 28 | height = 600, 29 | filename = "nCov2019.gif", 30 | fps = 2, 31 | type = "cases", 32 | ... 33 | ) 34 | } 35 | \arguments{ 36 | \item{x}{data for plot, it should be class of nCov2019 or nCov2019Hisory.} 37 | 38 | \item{region}{If Global or a specified region.} 39 | 40 | \item{continuous_scale}{logical, Whether to use continuous fill color, 41 | if TRUE(the default), use continuous type, otherwise use discrete type.} 42 | 43 | \item{palette}{If a string, will use that named palette. If a number, 44 | will index into the list of palettes of appropriate type. 45 | The list of available palettes can found in the Palettes section.} 46 | 47 | \item{date}{Specify the date.} 48 | 49 | \item{title}{Title of the map.} 50 | 51 | \item{type}{Specify the type of Statistics.} 52 | 53 | \item{...}{Additional parameters.} 54 | 55 | \item{from}{start date to plot} 56 | 57 | \item{to}{end date to plot. Both from and to should be specify, otherwise they will be ignored. 58 | If both from and to are specify, an animation will be created.} 59 | 60 | \item{width}{width of the plot, only works for animation} 61 | 62 | \item{height}{height of the plot, only works for animation} 63 | 64 | \item{filename}{name of output file.} 65 | 66 | \item{fps}{fps of the animation, only works for animation} 67 | } 68 | \value{ 69 | A 'ggplot' object 70 | } 71 | \description{ 72 | plot map with ggplots, it is the core of plot.nCov2019 and Plot.nCov2019History. 73 | } 74 | -------------------------------------------------------------------------------- /R/open_dashboard.R: -------------------------------------------------------------------------------- 1 | ##' @title Shiny app 2 | ##' @rdname dashboard 3 | ##' @title Dashboard for nCov2019 4 | ##' @description A dashboard app for nCov2019 package 5 | ##' @return No return value, open shiny app 6 | #' @examples 7 | #' \dontrun{ 8 | #' dashboard() 9 | #' # or 10 | #' open_dashboard() 11 | #'} 12 | ##' @importFrom downloader download 13 | ##' @export 14 | open_dashboard <- function() { 15 | package_need <- c('scales','shinycssloaders','shinydashboard', 'plotly', 'ggplot2', 16 | 'shiny', 'shinyBS', 'DT', 'tidyr', 'reshape2') 17 | package_no <- package_need[!is.installed(package_need)] 18 | 19 | if(length(package_no) != 0 ) { 20 | ## pa <- paste0(package_no,"\t") 21 | ## messages2 <- "Running this shiny app requires some additional R packages, download them? (Y/N): " 22 | ## ## button2 <- tcltk::tkmessageBox(title='Message', message=messages2, type='yesno') 23 | ## ## button2 <- tcltk::tclvalue(button2) 24 | ## button2 <- toupper(readline(prompt = messages2)) 25 | ## if(button2 == 'N'){ 26 | ## stop("Running this shiny app requires some additional R packages,", 27 | ## pa, ",please install them") 28 | ## } else { 29 | ## message("Running this shiny app requires some additional R packages,", 30 | ## pa, ",this will take some time") 31 | ## # install packages from CRAN 32 | ## ## sapply(package_no, utils::install.packages) 33 | ## utils::install.packages(package_no) 34 | ## } 35 | msg <- paste0("Running this shiny app requres several additional R packages to be installed:", 36 | "\n\t", paste0(package_no, collapse = ",")) 37 | stop(msg) 38 | } 39 | pos <- 1 40 | envir <- as.environment(pos) 41 | if (!exists("nCov2019Env", envir = .GlobalEnv)) { 42 | assign("nCov2019Env", new.env(), envir = envir) 43 | } 44 | nCov2019Env <- get("nCov2019Env", envir = .GlobalEnv) 45 | options(nCov2019_dashboard = TRUE) 46 | 47 | # run shinyApp 48 | shiny::runApp(appDir = system.file("shinyapp" ,package="nCov2019") ) 49 | } 50 | 51 | ##' @rdname dashboard 52 | ##' @export 53 | dashboard <- open_dashboard 54 | 55 | is.installed <- function(packages) { 56 | vapply(packages, function(pkg) { 57 | system.file(package = pkg) != "" 58 | }, logical(1)) 59 | } 60 | 61 | 62 | 63 | 64 | -------------------------------------------------------------------------------- /example.R: -------------------------------------------------------------------------------- 1 | 2 | require(dplyr) 3 | require(ggplot2) 4 | require(shadowtext) 5 | require(nCov2019) 6 | 7 | res <- query() 8 | y <- res$historical 9 | d <- y["global"] 10 | 11 | time = as.Date("2021-01-10") 12 | dd <- filter(d, date == time) %>% 13 | arrange(desc(cases)) 14 | 15 | dd = dd[1:40, ] 16 | dd$country = factor(dd$country, levels=dd$country) 17 | k = median(dd$cases) 18 | 19 | dd$angle = 1:40 * 360/40 20 | require(ggplot2) 21 | p <- ggplot(dd, aes(country, cases, fill=cases)) + 22 | geom_col(width=1, color='grey90') + 23 | geom_col(aes(y=I(5)), width=1, fill='grey90', alpha = .2) + 24 | geom_col(aes(y=I(3)), width=1, fill='grey90', alpha = .2) + 25 | geom_col(aes(y=I(2)), width=1, fill = "white") + 26 | scale_y_log10() + 27 | scale_fill_gradientn(colors=c("darkgreen", "green", "orange", "firebrick","red"), trans="log") + 28 | geom_text(aes(label=paste(country, cases, sep="\n"), 29 | y = cases *.8, angle=angle), 30 | data=function(d) d[d$cases > k,], 31 | size=2, color = "white", fontface="bold", vjust=1) + 32 | geom_text(aes(label=paste0(cases, " cases ", country), 33 | y = max(cases) * 2, angle=angle+90), 34 | data=function(d) d[d$cases < k,], 35 | size=3, vjust=0) + 36 | coord_polar(direction=-1) + 37 | theme_void() + 38 | theme(legend.position="none") + 39 | ggtitle("COVID19 global trend", time) 40 | 41 | p1 = ggplotify::as.ggplot(p, scale=1.2) 42 | 43 | 44 | 45 | y <- res$historical 46 | d <- y["global"] 47 | 48 | 49 | 50 | dd <- d %>% 51 | as_tibble %>% 52 | filter(cases > 1000000) %>% 53 | group_by(country) %>% 54 | mutate(days_since_1m = as.numeric(date - min(date))) %>% 55 | ungroup 56 | 57 | breaks=c(1000, 10000, 20000, 50000, 500000,500000,5000000,20000000) 58 | 59 | 60 | p2 <- ggplot(dd, aes(days_since_1m, cases, color = country)) + 61 | geom_smooth(method='lm', aes(group=1), 62 | data = dd, 63 | color='grey10', linetype='dashed') + 64 | geom_line(size = 0.8) + 65 | geom_point(pch = 21, size = 1) + 66 | scale_y_log10(expand = expansion(add = c(0,0.1)), 67 | breaks = breaks, labels = breaks) + 68 | scale_x_continuous(expand = expansion(add = c(0,1))) + 69 | theme_minimal(base_size = 14) + 70 | theme( 71 | panel.grid.minor = element_blank(), 72 | legend.position = "none", 73 | plot.margin = margin(3,15,3,3,"mm") 74 | ) + 75 | coord_cartesian(clip = "off") + 76 | geom_shadowtext(aes(label = paste0(" ",country)), hjust=0, vjust = 0, 77 | data = . %>% group_by(country) %>% top_n(1,days_since_1m), 78 | bg.color = "white") + 79 | labs(x = "Number of days since 1,000,000th case", y = "", 80 | subtitle = "Total number of cases") 81 | 82 | 83 | require(cowplot) 84 | pp <- plot_grid(p, p2, ncol=2, labels=c("A", "B"), 85 | rel_heights=c(.7, 1)) 86 | ggsave(pp, filename = "nCov2019.jpg", width=12, height=8) 87 | 88 | -------------------------------------------------------------------------------- /R/utilities.R: -------------------------------------------------------------------------------- 1 | ##' @method [ nCov2019History 2 | ##' @export 3 | `[.nCov2019History` <- function(x, Country, Province, ...) { 4 | country <- province <- NULL 5 | if("Global" %in% Country || "global" %in% Country){ 6 | res = x$table 7 | } 8 | else if (missing(Province)){ 9 | res = subset(x$table, country %in% Country) 10 | } 11 | else { 12 | res = subset(x$province, country %in% Country & province %in% Province) 13 | } 14 | return(res) 15 | } 16 | 17 | ##' @method [ nCov2019 18 | ##' @export 19 | `[.nCov2019` <- function(x, Country, ...) { 20 | country <- NULL 21 | if("Global" %in% Country || "global" %in% Country){ 22 | res = x$table 23 | } else {res = subset(x$table, country %in% Country)} 24 | return(res) 25 | } 26 | 27 | ##' @method [ vaccine_therapeutics 28 | ##' @export 29 | `[.vaccine_therapeutics` <- function(x, ID, ...) { 30 | id <- NULL 31 | if("All" %in% ID || "all" %in% ID){ 32 | res = x$table[,!colnames(x$table) %in% "details"] 33 | } else {res = subset(x$table, id %in% ID)[,"details"]} 34 | return(res) 35 | } 36 | 37 | ##' @method summary vaccine_therapeutics 38 | ##' @export 39 | summary.vaccine_therapeutics <- function(object, ...){ 40 | return(object$summary) 41 | } 42 | 43 | 44 | ##' @method summary global_summary 45 | ##' @export 46 | summary.global_summary <- function(object, ...) { 47 | x <- object 48 | cat("Gloabl total ", x$cases, " cases; and ", x$deaths," deaths" ) 49 | cat("\nGloabl total affect country or areas:", x$affectedCountries) 50 | cat("\nGloabl total recovered cases:", x$todayRecovered) 51 | cat("\nlast update:", x$updated, "\n") 52 | } 53 | 54 | 55 | ##' @title convert 56 | ##' @rdname convert 57 | ##' @description Convert users' own data into class of nCov2019History data. Then it could be used in nCov2019. 58 | ##' @param data users' own data, it should contain these 6 column: "country","province","date","cases","deaths","recovered". 59 | ##' @return a 'nCov2019History' object 60 | ##' @export 61 | convert <- function(data) { 62 | if (sum(c("country","province","date","cases","deaths","recovered") %in% colnames(data)) != 6){ 63 | stop('Input data should contain these 6 column: "country","province","date","cases","deaths","recovered"') 64 | } 65 | 66 | cases_table <- data[,c("country","date","cases","deaths","recovered")] 67 | Pcases_table <- data[,c("country","province","date","cases","deaths","recovered")] 68 | 69 | res = list( 70 | table = cases_table[order(cases_table$country, cases_table$date), ], 71 | province = Pcases_table[order(Pcases_table$country, Pcases_table$date), ], 72 | time = as.character(max(cases_table$date)) 73 | ) 74 | class(res) = "nCov2019History" 75 | return(res) 76 | } 77 | 78 | ##' @importFrom stats aggregate 79 | clean_data <- function(data, object, by = "country") { 80 | cases_table = data.frame(data$timeline[[object]],check.names = F) 81 | if (by == "country") { 82 | by <- list(data$country) 83 | id <- c("Group.1") 84 | } else { 85 | by <- list(data$country,data$province) 86 | id <- c("Group.1", "Group.2") 87 | } 88 | tmp = aggregate(x = cases_table,by = by, FUN = sum) 89 | return(reshape2::melt(tmp, id = id, value.name = object)) 90 | } 91 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # nCov2019: An R package for exploring COVID-19 statistics 2 | 3 | The package was developed since Jan. 2020 and originally hosted on [GuangchuangYu/nCov2019](https://github.com/GuangchuangYu/nCov2019). This repo contains an up-to-date version with data from new sources (from worldometers and JHUCSSE) and new data types (vaccine and therapeutics data). 4 | 5 | 6 | ## :house: Data Sources 7 | 8 | + Latest data of coronavirus cases: [worldometers](https://www.worldometers.info/coronavirus/) 9 | + Historical data of coronavirus cases : [JHUCSSE](https://coronavirus.jhu.edu/map.html) 10 | + Vaccine data: [raps.org](https://www.raps.org/news-and-articles/news-articles/2020/3/covid-19-vaccine-tracker) 11 | + Therapeutics data: [raps.org](https://www.raps.org/news-and-articles/news-articles/2020/3/covid-19-therapeutics-tracker) 12 | 13 | Fetching data using API provided by [disease.sh](https://disease.sh) 14 | 15 | 16 | **Find out more on the vignette [vignette](https://yulab-smu.top/nCov2019/).** 17 | 18 | 19 | ## :writing\_hand: Authors 20 | 21 | Guangchuang YU and Tianzhi Wu 22 | 23 | [![](https://img.shields.io/badge/follow%20me%20on-WeChat-green.svg)](https://yulab-smu.top/images/biobabble.jpg) 24 | 25 | 26 | 27 | 28 | If you use `nCov2019`, please cite the following article: 29 | 30 | Wu T, Hu E, Ge X\*, Yu G\*. 2021. nCov2019: an R package for studying the COVID-19 coronavirus pandemic. __*PeerJ*__ 9:e11421 31 | 32 | 33 | 34 | ## :arrow\_double\_down: Installation 35 | 36 | Get the development version from github: 37 | 38 | ``` r 39 | ## install.packages("remotes") 40 | remotes::install_github("YuLab-SMU/nCov2019") 41 | ``` 42 | 43 | ## :beginner: Usages 44 | 45 | + `res <- query()` to query 5 types of statistics 46 | + global summary, 47 | + latest data 48 | + historical data 49 | + vaccine data 50 | + therapeutic data 51 | + `x <- res$global` to access global summary data 52 | + `summary(x)` will return global overview 53 | + `x$affectedCountries` will return total affected countries,(other 20 types of statistics is available) 54 | + `y <- res$latest` or `y <- res$historical` to access `latest` or `historical` data 55 | + `y["global"]` will return all countries' statistics 56 | + `y[country]` will return country level statistics 57 | + For countries in `China`, `UK`, `Australia`, `Canada` ,`Denmark` , `France` and `Netherlands`, provincial data is also available and `y[country,province]` will return statistics data of the selected province 58 | + `z <- res$vaccine` or `y <- res$therapeutics` to access `vaccine` or `therapeutic` data 59 | + `summary(z)` will return the summary of their trial phase 60 | + `z["all"]` will return all candidate 61 | + `z[ID="id1"]` each vaccine or therapeutics candidate has an id, this will return detail description of the selected candidate (*e.g.*, "id1") 62 | + `plot()` to present data on map 63 | + `dashboard()` to open Shiny app dashboard 64 | 65 | ## :art: Example 66 | 67 | Run the script [example.R](example.R) in R using `source("example.R")`, will produce the following figure: 68 | 69 | ![](./nCov2019.jpg) 70 | 71 | ## :book: Documents 72 | 73 | + [online vignette](https://yulab-smu.top/nCov2019/) 74 | + [An R Package to Explore the Novel Coronavirus](https://towardsdatascience.com/an-r-package-to-explore-the-novel-coronavirus-590055738ad6) 75 | 76 | 77 | ## :chart\_with\_upwards\_trend: Shiny Apps that use `nCov2019` 78 | 79 | + [Coronavirus Tracking dashboard](https://coronavirus.john-coene.com/) 80 | + [Novel Coronavirus Pneumonia (NCP-2019) Dashboard](https://github.com/gaospecial/NCPdashboard) 81 | + [Coronavirus COVID-19 outbreak statistics and forecast](http://www.bcloud.org/e/) 82 | 83 | 84 | ## :sparkling\_heart: Collected in resource list 85 | 86 | + [Open-Source-COVID-19](https://weileizeng.github.io/Open-Source-COVID-19/) 87 | + [Top 7 R resources on COVID-19 Coronavirus](https://www.statsandr.com/blog/top-r-resources-on-covid-19-coronavirus/) 88 | + [COVID-19 Coronavirus Disease resources](http://covirusd.com/resources/) 89 | -------------------------------------------------------------------------------- /R/query.R: -------------------------------------------------------------------------------- 1 | #' @rdname query 2 | #' @title Query COVID-19 related statistic data 3 | #' @description The main function for query nCov2019 related statistic data, 4 | #' @return result contains 5 types of data: 5 | #' * global: The global overall summary statistic 6 | #' * latest: The global latest statistic for all countries 7 | #' * historical: The historical statistic for all countries 8 | #' * vaccine: The current vaccine development progress 9 | #' * therapeutics: The current therapeutics development progress 10 | #' @examples 11 | #' \dontrun{ 12 | #' res <- query() 13 | #' names(res) 14 | #'} 15 | #' @export 16 | #' @md 17 | query <- function(){ 18 | message("Querying the latest data...") 19 | latest_data <- get_latest_data();print(latest_data) 20 | message("Querying the global data...") 21 | global_data <- get_global_data();summary(global_data) 22 | message("Querying the historical data...") 23 | historical_data <- get_history_data() 24 | # message("Querying the vaccine data...") 25 | # vaccine_data <- get_vaccine_data();print(vaccine_data) 26 | # message("Querying the therapeutics data...") 27 | # therapeutics_data <- get_therapeutics_data();print(therapeutics_data) 28 | message("Query finish, each time you can launch query() to reflash the data") 29 | res = list(latest=latest_data, 30 | global=global_data, 31 | historical=historical_data) 32 | # vaccine=vaccine_data, 33 | # therapeutics=therapeutics_data) 34 | return(res) 35 | } 36 | 37 | ##' Query global latest statistic for all contries 38 | ##' 39 | ##' 40 | ##' @title Query the latest data online 41 | ##' @return A 'nCov2019' object 42 | ##' @export 43 | ##' @author Guangchuang Yu 44 | get_latest_data <- function() { 45 | url <- "https://disease.sh/v3/covid-19/countries?yesterday=1&twoDaysAgo=0&sort=todayCases" 46 | local <- file.path("local_storage","latest_data.json.gz") 47 | data <- dl(url,local) 48 | 49 | data$updated = sapply(data$updated, function(x){as.character( 50 | as.Date(as.POSIXct( x/1000, origin="1970-01-01")))} ) 51 | res = list( 52 | table = data[c("country","cases","deaths","recovered","active","todayCases", 53 | "todayDeaths", "todayRecovered","population","tests","updated")], 54 | detail = data[,!colnames(data) %in% c("countryInfo.flag")], 55 | time = max(data$updated) 56 | ) 57 | class(res) = "nCov2019" 58 | return(res) 59 | } 60 | 61 | 62 | 63 | #' @title Query the global data online 64 | #' @return A 'global_summary' object 65 | #' @examples 66 | #' \dontrun{ 67 | #' x <- get_global_data() 68 | #'} 69 | get_global_data <- function() { 70 | url <- "https://disease.sh/v3/covid-19/all?yesterday=false&twoDaysAgo=0" 71 | local <- file.path("local_storage","global_data.json.gz") 72 | data <- dl(url,local) 73 | data$updated = as.character( 74 | as.Date(as.POSIXct( data$updated/1000, origin="1970-01-01"))) 75 | res = data.frame(data) 76 | class(res) = "global_summary" 77 | return(res) 78 | } 79 | 80 | 81 | #' @title Query the historical data online 82 | #' @return A 'nCov2019History' object 83 | #' @examples 84 | #' \dontrun{ 85 | #' x <- get_history_data() 86 | #'} 87 | get_history_data <- function() { 88 | url <- "https://disease.sh/v3/covid-19/historical?lastdays=all" 89 | local <- file.path("local_storage","historical_data.json") 90 | data <- dl(url,local) 91 | 92 | cases_table <- clean_data(data = data, object = "cases") 93 | deaths_table <- clean_data(data = data, object = "deaths") 94 | recovered_table <- clean_data(data = data, object = "recovered") 95 | cases_table$deaths = deaths_table$deaths 96 | cases_table$recovered = recovered_table$recovered 97 | colnames(cases_table)[1:2] = c("country","date") 98 | cases_table$date <- as.Date(format(as.Date(cases_table$date, "%m/%d/%y"), "%Y-%m-%d")) 99 | 100 | 101 | # `P` for province 102 | Pcases_table <- clean_data(data = data, object = "cases", by = "province") 103 | Pdeaths_table <- clean_data(data = data, object = "deaths", by = "province") 104 | Precovered_table <- clean_data(data = data, object = "recovered", by = "province") 105 | Pcases_table$deaths = Pdeaths_table$deaths 106 | Pcases_table$recovered = Precovered_table$recovered 107 | colnames(Pcases_table)[1:3] = c("country","province","date") 108 | Pcases_table$date <- as.Date(format(as.Date(Pcases_table$date, "%m/%d/%y"), "%Y-%m-%d")) 109 | 110 | res = list( 111 | table = cases_table[order(cases_table$country, cases_table$date), ], 112 | province = Pcases_table[order(Pcases_table$country, Pcases_table$date), ], 113 | time = as.character(max(cases_table$date)) 114 | ) 115 | class(res) = "nCov2019History" 116 | return(res) 117 | } 118 | 119 | 120 | 121 | #' @title Query the vaccine info online 122 | #' @return A 'vaccine_therapeutics' object 123 | #' @examples 124 | #' \dontrun{ 125 | #' x <- get_vaccine_data() 126 | #'} 127 | get_vaccine_data <- function() { 128 | url <- "https://disease.sh/v3/covid-19/vaccine" 129 | local <- file.path("local_storage","vaccine_data.json.gz") 130 | data <- dl(url,local) 131 | table <- data$data 132 | 133 | table$institutions = sapply(table$institutions,function(x){paste(x[[1]], collapse = "|")}) 134 | table$sponsors = sapply(table$sponsors,function(x){paste(x[[1]], collapse = "|")}) 135 | table$id = paste0("id",1:nrow(table)) 136 | table = table[ c("id", colnames(table)[-ncol(table)]) ] # reorder 137 | res = list( 138 | table = table, 139 | summary = data$phases, 140 | totalCandidates = data$totalCandidates 141 | ) 142 | class(res) = "vaccine_therapeutics" 143 | return(res) 144 | } 145 | 146 | 147 | #' @title Query the therapeutics info online 148 | #' @return A 'vaccine_therapeutics' object 149 | #' @examples 150 | #' \dontrun{ 151 | #' x <- get_therapeutics_data() 152 | #'} 153 | get_therapeutics_data <- function() { 154 | url <- "https://disease.sh/v3/covid-19/therapeutics" 155 | local <- file.path("local_storage","therapeutics_data.json.gz") 156 | data <- dl(url,local) 157 | table <- data$data 158 | 159 | table$tradeName = sapply(table$tradeName,function(x){paste(x[[1]], collapse = "|")}) 160 | table$developerResearcher = sapply(table$developerResearcher,function(x){paste(x[[1]], collapse = "|")}) 161 | table$sponsors = sapply(table$sponsors,function(x){paste(x[[1]], collapse = "|")}) 162 | table$lastUpdate <- as.Date(format(as.Date(table$lastUpdate , "%m/%d/%y"), "%Y-%m-%d")) 163 | table$id = paste0("id",1:nrow(table)) 164 | table = table[ c("id", colnames(table)[-ncol(table)]) ] # reorder 165 | res = list( 166 | table = table, 167 | summary = data$phases, 168 | totalCandidates = data$totalCandidates 169 | ) 170 | class(res) = "vaccine_therapeutics" 171 | return(res) 172 | } 173 | 174 | #' @rdname get_nCov2019 175 | #' @title Query the latest data 176 | #' @description Query the latest data online;deprecated, 177 | ##' use get_latest_data() in the further. 178 | #' @return The latest statistic data 179 | #' @examples 180 | #' \dontrun{ 181 | #' x <- get_nCov2019() 182 | #'} 183 | #' @export 184 | get_nCov2019 <- function(){ 185 | message("`get_nCov2019()` has been deprecated and used `query()` instead of") 186 | message("Querying the latest data...") 187 | res <- get_latest_data() 188 | return(res) 189 | } 190 | 191 | #' @rdname load_nCov2019 192 | #' @title Query the latest data 193 | #' @description Query the historical data online;deprecated, 194 | ##' use load_nCov2019() in the further. 195 | #' @return The historical statistic data 196 | #' @examples 197 | #' \dontrun{ 198 | #' x <- load_nCov2019() 199 | #'} 200 | #' @export 201 | load_nCov2019 <- function(){ 202 | message("`load_nCov2019()` has been deprecated and used `query()` instead of.") 203 | message("Querying the historical data...") 204 | res <- get_history_data() 205 | return(res) 206 | } 207 | 208 | 209 | ##' @importFrom utils download.file 210 | dl <- function(url,local){ 211 | tryCatch({ 212 | d = tempfile() 213 | status <- download.file(url, quiet = T, destfile = d) 214 | data <- jsonlite::fromJSON(d) 215 | }, 216 | error= function(e) { 217 | message("Failed to query online data, please check the network connection.\n 218 | A local data stored on 2021-01-11 will be loaded.") 219 | data <- jsonlite::fromJSON(system.file(local, package="nCov2019")) 220 | }) 221 | return(data) 222 | } 223 | -------------------------------------------------------------------------------- /R/plot.R: -------------------------------------------------------------------------------- 1 | ##' @rdname plot 2 | ##' @title plot.nCov2019 3 | ##' @method plot nCov2019 4 | ##' @description plot map with ggplots, it is the core of plot.nCov2019 and Plot.nCov2019History. 5 | ##' @param x data for plot, it should be class of nCov2019 or nCov2019Hisory. 6 | ##' @param region If Global or a specified region. 7 | ##' @param continuous_scale logical, Whether to use continuous fill color, 8 | ##' if TRUE(the default), use continuous type, otherwise use discrete type. 9 | ##' @param palette If a string, will use that named palette. If a number, 10 | ##' will index into the list of palettes of appropriate type. 11 | ##' The list of available palettes can found in the Palettes section. 12 | ##' @param date Specify the date. 13 | ##' @param title Title of the map. 14 | ##' @param type Specify the type of Statistics. 15 | ##' @param ... Additional parameters. 16 | ##' @return A 'ggplot' object 17 | ##' @importFrom ggplot2 aes_ 18 | ##' @importFrom ggplot2 map_data 19 | ##' @importFrom ggplot2 geom_map 20 | ##' @importFrom ggplot2 ggplot 21 | ##' @importFrom ggplot2 coord_equal 22 | ##' @importFrom ggplot2 theme_minimal 23 | ##' @importFrom ggplot2 xlab 24 | ##' @importFrom ggplot2 ylab 25 | ##' @importFrom ggplot2 labs 26 | ##' @importFrom ggplot2 aes_string 27 | ##' @export 28 | plot.nCov2019 <- function(x, region = "Global", continuous_scale = FALSE, palette = "Reds", 29 | date = NULL, title = "COVID19", type = "cases", ... ) { 30 | country <- NULL 31 | if (inherits(x, "nCov2019")){ 32 | type_list = c("cases","deaths","recovered","active","todayCases", 33 | "todayDeaths","todayRecovered","population","tests") 34 | } else if(inherits(x, "nCov2019History")){ 35 | type_list = c("cases","deaths","recovered","active") 36 | } 37 | 38 | if (!type %in% type_list ) { 39 | msg <- paste("`type` should be one of below:\n", 40 | paste(type_list, collapse=","), "\n") 41 | stop(msg) 42 | } 43 | 44 | if (!is.null(date)) { 45 | caption <- paste("accessed date:", date) 46 | } 47 | else if("time" %in% names(x)) { 48 | date = x$time 49 | caption <- paste("accessed date:", date) 50 | } 51 | else { 52 | caption <- NA 53 | } 54 | 55 | # get the subset of one day for historical_data 56 | if (inherits(x, "nCov2019History")) { 57 | time = date 58 | dt = subset(x$table, date == time) 59 | } else{ 60 | dt = x$table 61 | } 62 | 63 | # caculate the summary data 64 | if (region != "Global") { 65 | d <- subset(dt[c("country", type)], country == region) 66 | total = d[[type]][1] 67 | } else { 68 | d <- dt[c("country", type)] 69 | total <- sum(d[[type]]) 70 | } 71 | 72 | subtitle = paste(region, type, ":", total) 73 | if (region == "China") { 74 | subtitle = paste("China[Mainland]", type, ":", total) 75 | } 76 | 77 | if (region == "Global") region <- "." 78 | world <- map_data('world', region = region) 79 | world <- world[world$region != "Antarctica", ] 80 | w <- merge(world, d, by.x='region', by.y='country', all.x=T) 81 | w[[type]][is.na(w[[type]])] = 0 82 | w <- w[order(w$order),] 83 | p <- ggplot(w, aes_(~long, ~lat)) + 84 | coord_equal() + 85 | theme_minimal(base_size = 14) + 86 | xlab(NULL) + ylab(NULL) + 87 | labs(title = title, 88 | subtitle = subtitle, 89 | caption= caption ) 90 | discrete_type = paste0(type,"2") 91 | w[[discrete_type]] = cut(w[[type]], discrete_breaks, 92 | include.lowest = T, right=F) 93 | 94 | if (continuous_scale) { 95 | if (length(unique(w[[type]])) == 1) { 96 | col <- RColorBrewer::brewer.pal(3, palette)[3] 97 | p1 <- p + 98 | geom_map(aes_(~long, ~lat, map_id = ~region, group=~group), 99 | map=w, data=w, colour='grey', fill = col) 100 | 101 | } else { 102 | p1 <- p + 103 | geom_map(aes_string("long", "lat", map_id = "region", group="group", fill=type), 104 | map=w, data=w, colour='grey') + 105 | fill_scale_continuous(palette) 106 | } 107 | } else { 108 | p1 <- p + 109 | geom_map(aes_string("long", "lat", map_id = "region", group="group", fill=discrete_type), 110 | map=w, data=w, colour='grey') + 111 | fill_scale_discrete(palette) 112 | } 113 | 114 | 115 | #p1 <- p + 116 | # geom_map(aes_(~long, ~lat, map_id=~region, group=~group, fill=~cases2), map=w, data=w, colour='grey') 117 | 118 | return(p1 ) 119 | } 120 | 121 | discrete_breaks <- c(1,10,100, 10^3,10^4, 10^5, 10^6,10^7,10^8, 10^9, 10^10) 122 | 123 | fill_scale_discrete <- function(palette = "Reds") { 124 | ggplot2::scale_fill_brewer(palette=palette, name=' ', 125 | na.translate = FALSE, 126 | breaks = c('[0,10)','[10,100)', '[100,1e+03)', '[1e+03,1e+04)', '[1e+04,1e+05)', 127 | '[1e+05,1e+06)', '[1e+06,1e+07)','[1e+07,1e+08)','[1e+08,1e+09)', 128 | '[1e+09,1e+10)'), 129 | labels = c(expression(0-10^1), 130 | expression(10^1-10^2), 131 | expression(10^2-10^3), 132 | expression(10^3-10^4), 133 | expression(10^4-10^5), 134 | expression(10^5-10^6), 135 | expression(10^6-10^7), 136 | expression(10^7-10^8), 137 | expression(10^8-10^9), 138 | expression(10^9-10^10))) 139 | } 140 | 141 | fill_scale_continuous <- function(palette = "Reds") { 142 | cols = RColorBrewer::brewer.pal(6, palette) 143 | breaks = c( 10, 10^2, 10^3, 10^4,10^5,10^6,10^7,10^8) 144 | labels = c( expression(10^1), 145 | expression(10^2), 146 | expression(10^3), 147 | expression(10^4), 148 | expression(10^5), 149 | expression(10^6), 150 | expression(10^7), 151 | expression(10^8) ) 152 | ggplot2::scale_fill_gradient(low=cols[1], high=cols[6], 153 | na.value='white', trans='log', 154 | breaks=breaks,labels = labels) 155 | } 156 | 157 | ##' @rdname plot 158 | ##' @title plot.nCov2019History 159 | ##' @method plot nCov2019History 160 | ##' @param from start date to plot 161 | ##' @param to end date to plot. Both from and to should be specify, otherwise they will be ignored. 162 | ##' If both from and to are specify, an animation will be created. 163 | ##' @param width width of the plot, only works for animation 164 | ##' @param height height of the plot, only works for animation 165 | ##' @param fps fps of the animation, only works for animation 166 | ##' @param filename name of output file. 167 | ##' @export 168 | plot.nCov2019History <- function(x, region="Global", 169 | continuous_scale = TRUE, 170 | palette = "Reds", date=NULL, 171 | from = NULL, to = NULL, 172 | width = 600, height = 600, 173 | filename = "nCov2019.gif", 174 | fps=2, type="cases", ...) { 175 | if (is.null(from) || is.null(to)) { 176 | 177 | p <- plot.nCov2019(x = x, date=date, 178 | region = region,type=type, 179 | continuous_scale = continuous_scale, 180 | palette = palette, ...) 181 | return(p) 182 | } 183 | 184 | from <- as.Date(from) 185 | to <- as.Date(to) 186 | d <- seq(from, to, by = 1) 187 | 188 | out <- lapply(d, function(date){ 189 | 190 | p <- plot.nCov2019(x = x, 191 | region = region, type=type, 192 | continuous_scale = continuous_scale, 193 | palette = palette, date = date, ...) 194 | }) 195 | 196 | leg <- cowplot::get_legend(out[[length(out)]]) 197 | out <- lapply(out, function(g) { 198 | ## ggplotify::as.ggplot(g + ggplot2::theme(legend.position="none")) + 199 | ## ggimage::geom_subview(subview = leg, x=.9, y=.2) 200 | cowplot::plot_grid(g + ggplot2::theme(legend.position="none"), 201 | leg, rel_widths = c(1, .3)) 202 | }) 203 | 204 | 205 | img <- magick::image_graph(600, 600, res = 96) 206 | invisible(lapply(out, function(p) suppressWarnings(print(p)))) 207 | grDevices::dev.off() 208 | 209 | animation <- magick::image_animate(img, fps = fps) 210 | msg <- paste0("A gif, ", filename, ", was generated in current directory\n") 211 | message(msg) 212 | magick::image_write(animation, filename) 213 | invisible(animation) 214 | } 215 | -------------------------------------------------------------------------------- /vignettes/nCov2019.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'nCov2019: A R package for studying COVID-19 coronavirus outbreak' 3 | author: 4 | - name: Tianzhi Wu, Erqiang Hu, Patrick Tung, Xijin Ge, Guangchuang Yu 5 | date: "`r Sys.Date()`" 6 | output: 7 | html_document: 8 | toc: yes 9 | df_print: paged 10 | pdf_document: 11 | toc: yes 12 | prettydoc::html_pretty: 13 | toc: yes 14 | theme: cayman 15 | highlight: github 16 | package: nCov2019 17 | vignette: | 18 | %\VignetteIndexEntry{nCov2019 introduction} 19 | %\VignetteEncoding{UTF-8} 20 | %\VignetteEngine{knitr::rmarkdown} 21 | --- 22 | 23 | To provide convenient access to epidemiological data on the coronavirus outbreak, we developed an R package, nCov2019 (https://github.com/yulab-smu/nCov2019). Besides detailed basis statistics, it also includes information about vaccine development and therapeutics candidates. We redesigned the function plot() for geographic maps visualization and provided a interactive shiny app. These analytics tools could be useful in informing the public and studying how this and similar viruses spread in populous countries. 24 | 25 | Our R package is designed for both command line and dashboard interaction analysis, As show in diagram, while `dashboard()` is the main entry for the GUI explore part, the `query()` is the main function used in CLI explore part, 5 types of data were contain in its return result. Result type were explain in **Statistic query** part. 26 | 27 | ![](introduction.png) 28 | 29 | ## Installation 30 | 31 | To start off, users could utilize the 'remotes' package to install it directly from GitHub by running the following in R: 32 | ```{r eval=FALSE} 33 | remotes::install_github("yulab-smu/nCov2019", dependencies = TRUE) 34 | ``` 35 | 36 | 37 | ## Statistic query 38 | 39 | Data query is simple as one command: 40 | ```{r} 41 | library("nCov2019") 42 | res <- query() 43 | ``` 44 | 45 | This may take seconds to few minutes, which depend on the users' network connection, if the user connection is broken, a local stored version data will be used for demo. 46 | 47 | The result returned by `query()` function will contains 5 types of statistic: 48 | 49 | 50 | ```{r} 51 | names(res) 52 | ``` 53 | 54 | - `global` The global overall summary statistic 55 | - `latest` The global latest statistic for all countries 56 | - `historical` The historical statistic for all countries 57 | - ~~`vaccine` The current vaccine development progress~~ 58 | - ~~`therapeutics` The current therapeutics development progress~~ 59 | 60 | The `query()` only need to be performed once in a session, print each of statistic objects, users could get their update time. And for the `vaccine` and `therapeutics` query results, print them will return the candidates number. 61 | 62 | 63 | ### Global data 64 | 65 | The query result of global status will contain a data frame with 21 types of statistic, which have detail explanation on the bottom of this documents. And `summary(x)` will return overview of global status. 66 | 67 | ```{r} 68 | x = res$global 69 | x$affectedCountries # total affected countries 70 | summary(x) 71 | ``` 72 | 73 | 74 | 75 | ### Latest data 76 | 77 | Here is the example for operating latest data. once again, all data have queried and store in `res`. 78 | ```{r} 79 | x = res$latest 80 | ``` 81 | 82 | And then `print(x)` will return the update time for the latest data 83 | ```{r} 84 | print(x) # check update time 85 | ``` 86 | 87 | To subset latest data could be easily done by using `[`. `x["Global"]` or x`["global"]` will return the data frame for all countries but users could determine a specific country, such as: 88 | ```{r} 89 | head(x["Global"]) # return all global countries. 90 | x[c("USA","India")] # return only for USA and India 91 | ``` 92 | 93 | The data is order by "todayCases" column, users could sort them by other order. 94 | ```{r message=FALSE, warning=FALSE} 95 | df = x["Global"] 96 | head(df[order(df$cases, decreasing = T),]) 97 | ``` 98 | 99 | As for the latest data, it provides 11 types of main information by default, but 12 more statistic type are provided in the "latest\$detail", they also have corresponding explanation on the bottom. 100 | ```{r,message=FALSE, warning=FALSE} 101 | x = res$latest 102 | head(x$detail) # more detail data 103 | ``` 104 | 105 | ### Historical data 106 | 107 | Historical data is useful in retrospective analysis or to establish predictive models, the operation is similar as latest data, user could get the data frame for all countries or some specific countries within `c()` vector, such as `head(Z[c(country1,country2,country3)]) ` 108 | 109 | ```{r, warning=FALSE} 110 | Z = res$historical 111 | print(Z) # update time 112 | 113 | head(Z["Global"]) 114 | head(Z[c("China","UK","USA")]) 115 | ``` 116 | 117 | For the following countries, we provide detail province data, which can be obtained in a similar way but within `[ ` operation: `head(Z[country,province])` 118 | 119 | - `Australia` `Canada` `China` `Denmark` `France` `Netherlands` 120 | 121 | ```{r, warning=FALSE} 122 | head(Z['China','hubei']) 123 | ``` 124 | 125 | For users' own historical data, we provide a `convert()` function, users could convert other data into class of nCov2019History data, and then explore in nCov2019: 126 | 127 | ```{r eval=FALSE} 128 | userowndata <- read.csv("path_to_user_data.csv") 129 | # userowndata, it should contain these 6 column: 130 | # "country","province","date","cases","deaths","recovered" 131 | Z = convert(data=userowndata) 132 | head(Z["Global"]) 133 | ``` 134 | 135 | 136 |
137 | ### Vaccine and therapeutics data 138 | 139 | Users could check for the vaccine or therapeutics developing status. Let x be the vaccine or therapeutics query result, then `summary()` will return the summary of their trial phase, and x["all"] or x["All"] will return the summary information, such as mechanism, trial Phase, institutions and so on. Then the detail background info will return with provided id, for example x[ID="id3"] or simple as x["id3"]. The same operation could apply to therapeutics data. 140 | ```{r, warning=FALSE} 141 | X <- res$vaccine 142 | summary(X) 143 | 144 | head(X["all"]) 145 | 146 | # check for the details about the mRNA-based vaccine, id3 147 | X[ID="id3"] 148 | ``` 149 | 150 | ```{r, warning=FALSE} 151 | X <- res$therapeutics 152 | summary(X) 153 | head(X["All"]) 154 | X[ID="id1"] 155 | ``` 156 |
157 | 158 | ## Visualization 159 | 160 | We provide a visualization function as a redesign "plot". 161 | 162 | plot( 163 | x, 164 | region = "Global", 165 | continuous_scale = FALSE, 166 | palette = "Reds", 167 | date = NULL, 168 | from = NULL, 169 | to = NULL, 170 | title = "COVID-19", 171 | type = "cases", 172 | ... 173 | ) 174 | 175 | Here, type could be one of "cases","deaths","recovered","active","todayCases","todayDeaths","todayRecovered","population" and "tests". By default, color palette is "Reds", more color palettes can be found here: [palette](https://r-graph-gallery.com/38-rcolorbrewers-palettes.html). 176 | 177 | 178 | To get the overview for the latest status, the mini code required is as below: 179 | ```{r fig.height=8, fig.width=12, dpi=50, arning=FALSE} 180 | X <- res$latest 181 | plot(X) 182 | ``` 183 | 184 | 185 | 186 | Or To get the overview for the detection testing status, 187 | ```{r fig.height=8, fig.width=12, dpi=50,warning=FALSE} 188 | plot(X, type="tests",palette="Green") 189 | ``` 190 | 191 | 192 | 193 | It could be also intuitively compare the number of new confirmed cases per day among different countries. 194 | ```{r fig.height=8, fig.width=12, dpi=50,warning=FALSE} 195 | library(ggplot2) 196 | library(dplyr) 197 | X <- res$historical 198 | tmp <- X["global"] %>% 199 | group_by(country) %>% 200 | arrange(country,date) %>% 201 | mutate(diff = cases - lag(cases, default = first(cases))) %>% 202 | filter(country %in% c("Australia", "Japan", "Italy", "Germany", "China")) 203 | 204 | ggplot(tmp,aes(date, log(diff+1), color=country)) + geom_line() + 205 | labs(y="Log2(daily increase cases)") + 206 | theme(axis.text = element_text(angle = 15, hjust = 1)) + 207 | scale_x_date(date_labels = "%Y-%m-%d") + 208 | theme_minimal() 209 | ``` 210 | 211 | 212 | user could also plot the outbreak map on the past time with historical data by specify a date in function plot(). 213 | ```{r fig.height=8, fig.width=12, dpi=50,warning=FALSE} 214 | Y <- res$historical 215 | plot(Y, region="Global" ,date = "2020-08-01", type="cases") 216 | ``` 217 | 218 | 219 | 220 | ## Animations plot 221 | 222 | Animated world-wide epidemic maps could be generated in the similar way. This is the example to draw a spread animation from 2020-03-01 to 2020-08-01, with little code. 223 | 224 | ```{r eval=FALSE} 225 | library(nCov2019) 226 | res = query() 227 | from = "2020-03-01" 228 | to = "2020-08-01" 229 | y = res$historical 230 | plot(y, from = from, to=to) 231 | ``` 232 | 233 | 234 | ![](Animations.png) 235 | 236 | 237 | 238 | ## Other plots 239 | 240 | If you wanted to visualize the cumulative summary data, an example plot could be the following: 241 | 242 | ```{r fig.height=8, fig.width=12, dpi=50,warning=FALSE} 243 | library(ggplot2) 244 | x <- res$historical 245 | d = x['Japan' ] # you can replace Anhui with any province 246 | d = d[order(d$cases), ] 247 | 248 | ggplot(d, 249 | aes(date, cases)) + 250 | geom_col(fill = 'firebrick') + 251 | theme_minimal(base_size = 14) + 252 | xlab(NULL) + ylab(NULL) + 253 | scale_x_date(date_labels = "%Y/%m/%d") + 254 | labs(caption = paste("accessed date:", max(d$date))) 255 | 256 | ``` 257 | 258 | Plot the trend for for the Top 10 increase cases countries on last day 259 | ```{r fig.height=8, fig.width=10, dpi=50,warning=FALSE} 260 | library("dplyr") 261 | library("ggrepel") 262 | 263 | x <- res$latest 264 | y <- res$historical 265 | 266 | country_list = x["global"]$country[1:10] 267 | 268 | y[country_list] %>% 269 | subset( date > as.Date("2020-10-01") ) %>% 270 | group_by(country) %>% 271 | arrange(country,date) %>% 272 | mutate(increase = cases - lag(cases, default = first(cases))) -> df 273 | 274 | ggplot(df, aes(x=date, y=increase, color=country ))+ 275 | geom_smooth() + 276 | geom_label_repel(aes(label = paste(country,increase)), 277 | data = df[df$date == max(df$date), ], hjust = 1) + 278 | labs(x=NULL,y=NULL)+ 279 | theme_bw() + theme(legend.position = 'none') 280 | 281 | ``` 282 | 283 | Plot the curve of cases, recovered and deaths for specify country 284 | ```{r, warning=FALSE} 285 | library('tidyr') 286 | library('ggrepel') 287 | library('ggplot2') 288 | y <- res$historical 289 | country = "India" 290 | 291 | y[country] -> d 292 | d <- gather(d, curve, count, -date, -country) 293 | 294 | ggplot(d, aes(date, count, color = curve)) + geom_point() + geom_line() + 295 | labs(x=NULL,y=NULL,title=paste("Trend of cases, recovered and deaths in", country)) + 296 | scale_color_manual(values=c("#f39c12", "#dd4b39", "#00a65a")) + 297 | theme_bw() + 298 | geom_label_repel(aes(label = paste(curve,count)), 299 | data = d[d$date == max(d$date), ], hjust = 1) + 300 | theme(legend.position = "none", 301 | axis.text = element_text(angle = 15, hjust = 1)) + 302 | scale_x_date(date_labels = "%Y-%m-%d") 303 | ``` 304 | 305 | ## Heatmap for cases per country 306 | 307 | Here is the example code for draw a heatmap for the historical data range in nCov2019. 308 | ```{r fig.height=15, fig.width=6, dpi=50,warning=FALSE} 309 | library('tidyr') 310 | library('ggrepel') 311 | library('ggplot2') 312 | y <- res$historical 313 | d <- y["global"] 314 | 315 | d <- d[d$cases > 0,] 316 | length(unique(d$country)) 317 | d <- subset(d,date <= as.Date("2020-3-19")) 318 | max_time <- max(d$date) 319 | min_time <- max_time - 7 320 | d <- d[d$date >= min_time,] 321 | dd <- d[d$date == max(d$date,na.rm = TRUE),] 322 | 323 | d$country <- factor(d$country, 324 | levels=unique(dd$country[order(dd$cases)])) 325 | breaks = c(0,1000, 10000, 100000, 10000000) 326 | 327 | ggplot(d, aes(date, country)) + 328 | geom_tile(aes(fill = cases), color = 'black') + 329 | scale_fill_viridis_c(trans = 'log', breaks = breaks, 330 | labels = breaks) + 331 | xlab(NULL) + ylab(NULL) + 332 | scale_x_date(date_labels = "%Y-%m-%d") + theme_minimal() 333 | 334 | ``` 335 | 336 | Plot the global trend in a novel way. 337 | ```{r fig.height=10, fig.width=10, dpi=50,warning=FALSE} 338 | 339 | require(dplyr) 340 | 341 | y <- res$historical 342 | d <- y["global"] 343 | 344 | time = as.Date("2020-03-19") 345 | dd <- filter(d, date == time) %>% 346 | arrange(desc(cases)) 347 | 348 | dd = dd[1:40, ] 349 | dd$country = factor(dd$country, levels=dd$country) 350 | 351 | dd$angle = 1:40 * 360/40 352 | require(ggplot2) 353 | p <- ggplot(dd, aes(country, cases, fill=cases)) + 354 | geom_col(width=1, color='grey90') + 355 | geom_col(aes(y=I(5)), width=1, fill='grey90', alpha = .2) + 356 | geom_col(aes(y=I(3)), width=1, fill='grey90', alpha = .2) + 357 | geom_col(aes(y=I(2)), width=1, fill = "white") + 358 | scale_y_log10() + 359 | scale_fill_gradientn(colors=c("darkgreen", "green", "orange", "firebrick","red"), trans="log") + 360 | geom_text(aes(label=paste(country, cases, sep="\n"), 361 | y = cases *.8, angle=angle), 362 | data=function(d) d[d$cases > 700,], 363 | size=3, color = "white", fontface="bold", vjust=1) + 364 | geom_text(aes(label=paste0(cases, " cases ", country), 365 | y = max(cases) * 2, angle=angle+90), 366 | data=function(d) d[d$cases < 700,], 367 | size=3, vjust=0) + 368 | coord_polar(direction=-1) + 369 | theme_void() + 370 | theme(legend.position="none") + 371 | ggtitle("COVID19 global trend", time) 372 | p 373 | ``` 374 | 375 | 376 | Number of days since 1 million cases per country 377 | ```{r fig.height=8, fig.width=12, dpi=50,warning=FALSE} 378 | require(dplyr) 379 | require(ggplot2) 380 | require(shadowtext) 381 | 382 | 383 | y <- res$historical 384 | d <- y["global"] 385 | 386 | 387 | 388 | dd <- d %>% 389 | as_tibble %>% 390 | filter(cases > 1000000) %>% 391 | group_by(country) %>% 392 | mutate(days_since_1m = as.numeric(date - min(date))) %>% 393 | ungroup 394 | 395 | 396 | 397 | 398 | breaks=c(1000, 10000, 20000, 50000, 500000,500000,5000000,20000000) 399 | 400 | 401 | p <- ggplot(dd, aes(days_since_1m, cases, color = country)) + 402 | geom_smooth(method='lm', aes(group=1), 403 | data = dd, 404 | color='grey10', linetype='dashed') + 405 | geom_line(size = 0.8) + 406 | geom_point(pch = 21, size = 1) + 407 | scale_y_log10(expand = expansion(add = c(0,0.1)), 408 | breaks = breaks, labels = breaks) + 409 | scale_x_continuous(expand = expansion(add = c(0,1))) + 410 | theme_minimal(base_size = 14) + 411 | theme( 412 | panel.grid.minor = element_blank(), 413 | legend.position = "none", 414 | plot.margin = margin(3,15,3,3,"mm") 415 | ) + 416 | coord_cartesian(clip = "off") + 417 | geom_shadowtext(aes(label = paste0(" ",country)), hjust=0, vjust = 0, 418 | data = . %>% group_by(country) %>% top_n(1,days_since_1m), 419 | bg.color = "white") + 420 | labs(x = "Number of days since 1,000,000th case", y = "", 421 | subtitle = "Total number of cases") 422 | print(p) 423 | 424 | ``` 425 | 426 | 427 | ## Dashboard 428 | 429 | dashboard could launch as below: 430 | ```{r eval=FALSE} 431 | dashboard() 432 | ``` 433 | 434 | ![](dashboard.png) 435 | 436 | ## statistic item explanation 437 | 438 | | statistic | explain | 439 | | ---------------------- | ------------------------------------------------------ | 440 | | active | active number = comfirmed cases - deaths - recoveredd | 441 | | activePerOneMillion | active number / million population | 442 | | cases | comfirmed cases | 443 | | casesPerOneMillion | comfirmed cases / million population | 444 | | continent | continent | 445 | | country | country | 446 | | critical | Critical patients | 447 | | criticalPerOneMillion | Critical patients / million population | 448 | | date | date | 449 | | deaths | deaths | 450 | | deathsPerOneMillion | deaths patients / million population | 451 | | oneCasePerPeople | oneCasePerPeople | 452 | | oneDeathPerPeople | oneDeathPerPeople | 453 | | oneTestPerPeople | oneTestPerPeople | 454 | | population | population | 455 | | recovered | recovered | 456 | | recoveredPerOneMillion | recoveredPerOneMillion | 457 | | tests | COVID-19 test | 458 | | testsPerOneMillion | COVID-19 test / million population | 459 | | todayCases | comfirm cases in today | 460 | | todayDeaths | comfirm cases in today | 461 | | todayRecovered | comfirm cases in today | 462 | | updated | the latest update time | 463 | 464 | 465 | 466 | ## Citation 467 | 468 | If you use `nCov2019`, please cite the following preprint: 469 | 470 | Wu T, Hu E, Ge X\*, Yu G\*. 2021. nCov2019: an R package for studying the COVID-19 coronavirus pandemic. PeerJ 9:e11421 471 | 472 | 473 | ## Session Info 474 | ```{r} 475 | sessionInfo() 476 | ``` 477 | 478 | -------------------------------------------------------------------------------- /inst/shinyapp/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(tidyr) 3 | library(DT) 4 | library(ggplot2) 5 | library(shinydashboard) 6 | library(plotly) 7 | library(dplyr) 8 | library(nCov2019) 9 | 10 | get_latest_data <- getFromNamespace("get_latest_data", "nCov2019") 11 | get_global_data <- getFromNamespace("get_global_data", "nCov2019") 12 | get_history_data <- getFromNamespace("get_history_data", "nCov2019") 13 | #get_vaccine_data <- getFromNamespace("get_vaccine_data", "nCov2019") 14 | #get_therapeutics_data <- getFromNamespace("get_therapeutics_data", "nCov2019") 15 | 16 | ui <- dashboardPage( 17 | dashboardHeader(title = "nCov2019 Dashboard"), 18 | dashboardSidebar( 19 | 20 | # choose country 21 | selectizeInput( 22 | 'country', 'Choose Country', choices = NULL, 23 | options = list( 24 | placeholder = 'Choose Country', 25 | onInitialize = I('function() { this.setValue(""); }') 26 | ) 27 | ), 28 | 29 | # choose province 30 | selectizeInput('province', 'Choose Province', 31 | choices = c("Select Province" = NULL ), 32 | options = list( placeholder = 'Province')), 33 | tags$p(""), 34 | 35 | tags$div( 36 | tags$p("Download chosen data"), 37 | downloadButton('dataDownload', 'Download'),style = "padding: 12px 15px 0px 15px"), 38 | br(), 39 | actionButton("reflashButton", "Reflash data") 40 | ), 41 | 42 | dashboardBody( 43 | tags$head(tags$style(" 44 | .shiny-notification {position: fixed; top: 45% ;left: 50%} 45 | .logo, .main-sidebar {position: fixed }")), 46 | 47 | # header summary 48 | fluidRow( 49 | valueBoxOutput(outputId="summary_confirm"), 50 | valueBoxOutput(outputId="summary_cure"), 51 | valueBoxOutput(outputId="summary_dead") 52 | ), 53 | 54 | fluidRow( 55 | # data table 56 | shinydashboard::box(title = "Historical Data Table", 57 | solidHeader = T, 58 | width = 4, 59 | collapsible = T, 60 | shinycssloaders::withSpinner(DT::dataTableOutput("data_table")), 61 | style = "font-size: 70%;"), 62 | 63 | # line plot 64 | shinydashboard::box(title = "Cumulative Curve", solidHeader = T, 65 | width = 8, collapsible = T, 66 | shinycssloaders::withSpinner(plotlyOutput("line_plot"))) 67 | ), 68 | 69 | fluidRow( 70 | tabBox( 71 | width=12, 72 | title = "", 73 | selected = "Global Statistics", 74 | tabPanel("Global Statistics", 75 | # choose type 76 | #selectizeInput( 77 | # 'type', label = "Choose Global Statistics", choices = c("cases","deaths","recovered","active","todayCases", "todayDeaths","todayRecovered","population","tests"), 78 | # options = list(create = TRUE) 79 | # ), 80 | # choose date 81 | dateInput('date', label = 'Date:', min = '2020-01-22', value =NULL), 82 | shinycssloaders::withSpinner( 83 | plotlyOutput("Global_plot",height = '600', width = 'auto') 84 | )), 85 | # tabPanel("Vaccine Statisics", 86 | # shinydashboard::box( 87 | # width = 12, 88 | # collapsible = T, 89 | # shinycssloaders::withSpinner(DT::dataTableOutput("vaccine_table")), 90 | # style = "font-size: 70%;")), 91 | # tabPanel("Therapeutics Statisics", 92 | # shinydashboard::box( 93 | # width = 12, 94 | # collapsible = T, 95 | # shinycssloaders::withSpinner(DT::dataTableOutput("therapeutics_table")), 96 | # style = "font-size: 70%;")), 97 | # tabPanel("Medical Summary Table", 98 | # shinydashboard::box(title = "current therapeutics candidates ", 99 | # width = 6, 100 | # collapsible = T, 101 | # shinycssloaders::withSpinner(DT::dataTableOutput("Summary_table1")), 102 | # style = "font-size: 70%;"), 103 | # shinydashboard::box(title = "current vaccine candidates", 104 | # width = 6, 105 | # collapsible = T, 106 | # shinycssloaders::withSpinner(DT::dataTableOutput("Summary_table2")), 107 | # style = "font-size: 70%;") 108 | # ), 109 | tabPanel("Active per Million", plotlyOutput("active_plot")), 110 | tabPanel("Deaths per Million", plotlyOutput("Mortality_plot")), 111 | tabPanel("Cor Plot", 112 | # choose type 113 | tags$div(style = "display: flex;", 114 | selectizeInput( 'cor_type1', label = "Variable X", choices = NULL,options = list(create = TRUE)), 115 | selectizeInput( 'cor_type2', label = "Variable Y", choices = NULL,options = list(create = TRUE))), 116 | plotlyOutput("cor_plot")), 117 | tabPanel("Daily Increase Curve", 118 | selectizeInput('country_list2', label = "Click or input countries to plot curve", 119 | choices = NULL,multiple = TRUE,options = list(create = TRUE,multiple = TRUE)), 120 | plotlyOutput("wave_plot")) 121 | ) 122 | ) # end row 123 | ) # end dashboard body 124 | 125 | ) # end UI 126 | 127 | server <- function(input, output, session, ...) { 128 | # query and reflash data 129 | reflash <- function(){ 130 | withProgress({ 131 | incProgress(message = "Querying the lastest data") 132 | lastest_data <- get_latest_data() 133 | incProgress(message = "Querying the global summary data") 134 | global_data <- get_global_data() 135 | incProgress( message = "Querying the historical data") 136 | historical_data <- get_history_data() 137 | #incProgress( message = "Querying the vaccine data") 138 | #vaccine_data <- get_vaccine_data() 139 | #incProgress( message = "Querying the therapeutics data") 140 | #therapeutics_data <- get_therapeutics_data() 141 | res = list(lastest=lastest_data, 142 | global=global_data, 143 | #vaccine=vaccine_data, 144 | #therapeutics=therapeutics_data, 145 | historical=historical_data) 146 | return(res) 147 | }) 148 | return(res) 149 | } 150 | res <- reflash() 151 | lastest_data=res$lastest 152 | global_data=res$global 153 | historical_data=res$historical 154 | vaccine_data=res$vaccine 155 | therapeutics_data=res$therapeutics 156 | 157 | # update country list 158 | country_list <- dplyr::filter(lastest_data$table, updated == lastest_data$time) %>% 159 | arrange(desc(cases)) %>% .$country 160 | updateSelectizeInput(session, 'country', choices = country_list, server = TRUE) 161 | 162 | t = historical_data$time 163 | 164 | # update province list 165 | observe({ 166 | province_list <- unique(subset(historical_data$province, country == input$country)$province) 167 | if (length(province_list) > 0) { 168 | updateSelectInput(session, "province", choices = c("All",province_list)) 169 | } else { 170 | updateSelectInput(session, "province", choices = c("--",province_list)) 171 | } 172 | 173 | }) 174 | 175 | # update cor_type list 176 | observe({ 177 | cor_type_list <- colnames(lastest_data$detail) 178 | cor_type_list <- cor_type_list[!cor_type_list %in% c("updated","country","countryInfo")] 179 | updateSelectInput(session, "cor_type1", 180 | choices = cor_type_list) 181 | updateSelectInput(session, "cor_type2", 182 | choices = cor_type_list[c(2,1,3:length(cor_type_list))]) 183 | }) 184 | 185 | # update country list2 186 | country_list <- unique(historical_data$table$country ) 187 | updateSelectizeInput(session, 'country_list2', choices = country_list, server = TRUE) 188 | 189 | updateDateInput(session, 'date', value = t, max=t) 190 | # prepare the table content 191 | df <- reactive({ 192 | if ( input$province == "All" | input$province == "--" ) { 193 | x = subset(historical_data$table, country == input$country) 194 | } 195 | else { 196 | x = subset(historical_data$province, province == input$province) 197 | } 198 | x = x[,c("date","cases","deaths","recovered")] 199 | return(x) 200 | }) 201 | historical_data$table %>% 202 | group_by(country) %>% 203 | arrange(country,date) %>% 204 | mutate(diff = cases - dplyr::lag(cases, default = dplyr::first(cases))) -> a 205 | # output data table 206 | output$data_table = DT::renderDataTable({ 207 | validate(need(input$country != "", "Loading")) 208 | df() 209 | },rownames = FALSE ) 210 | 211 | # output header summary 212 | output$summary_confirm <- renderValueBox({ 213 | validate(need(input$country != "", "Loading")) 214 | x = df() 215 | valueBox( 216 | paste0(x[which(x$date == t),]$cases, " Cases"), 217 | t, icon = icon("virus"), color = "yellow") 218 | }) 219 | 220 | output$summary_cure <- renderValueBox({ 221 | validate(need(input$country != "", "Loading")) 222 | x = df() 223 | valueBox( 224 | paste0(x[which(x$date == t),]$recovered, " Recovered"), 225 | t, icon = icon("hospital"), color = "navy") 226 | }) 227 | 228 | output$summary_dead <- renderValueBox({ 229 | validate(need(input$country != "", "Loading")) 230 | x = df() 231 | valueBox( 232 | paste0(x[which(x$date == t),]$deaths, " Deaths"), 233 | t, icon = icon("skull-crossbones"), color = "maroon") 234 | }) 235 | 236 | # Growth Curve 237 | output$line_plot <- renderPlotly({ 238 | validate(need(input$country != "", "Loading")) 239 | x = gather(df(), curve, count, -date) 240 | p = ggplot(x, aes(date, log2(count), color = curve, Counts=count, Type=curve )) + 241 | geom_point() + geom_line() + xlab(NULL) + ylab("Log2 of count") + 242 | scale_color_manual(values=c("#f39c12", "#d81b60", "#000080")) + 243 | theme_bw() + 244 | theme(legend.position = "none") + 245 | theme(axis.text = element_text(angle = 15, hjust = 1)) + 246 | scale_x_date(date_labels = "%Y-%m-%d") 247 | ggplotly(p,tooltip=c("x","Counts","Type")) 248 | }) 249 | 250 | # data download 251 | 252 | output$dataDownload <- downloadHandler( 253 | filename = function() {paste0("coronavirus_histrical_",t,".tsv")}, 254 | content = function(file) { 255 | # issues with Chinese characters solved 256 | # http://kevinushey.github.io/blog/2018/02/21/string-encoding-and-r/ 257 | con <- file(file, open = "w+", encoding = "native.enc") 258 | df <- df() 259 | df$country = input$country 260 | df$province = input$province 261 | writeLines( paste( colnames(df), collapse = "\t"), con = con, useBytes = TRUE) 262 | for(i in 1:nrow( df) ) 263 | #write line by line 264 | writeLines( paste( as.character(df[i,]), collapse = "\t"), con = con, useBytes = TRUE) 265 | close(con) 266 | } 267 | ) 268 | 269 | # bottom panel plots 270 | 271 | 272 | output$Global_plot <- renderPlotly({ 273 | #validate(need(input$type != "", "Loading")) 274 | 275 | geoINFO = data.frame( 276 | country = lastest_data$detail$country, 277 | ISO3 = lastest_data$detail$countryInfo$iso3, 278 | long = lastest_data$detail$countryInfo$long, 279 | lat = lastest_data$detail$countryInfo$lat, 280 | population = lastest_data$detail$population 281 | ) 282 | df = subset(historical_data$table ,date == input$date) 283 | df2 = merge(df, geoINFO, by='country') 284 | #lastest_data$detail$ISO2 = lastest_data$detail$countryInfo$iso2 285 | #lastest_data$detail$lat = lastest_data$detail$countryInfo$lat 286 | #lastest_data$detail$long = lastest_data$detail$countryInfo$long 287 | #lastest_data$detail$ISO3 = lastest_data$detail$countryInfo$iso3 288 | #df2 <- lastest_data$detail 289 | 290 | g <- list( 291 | scope = 'world', 292 | showland = TRUE, 293 | showcountries = TRUE, 294 | landcolor = toRGB("gray95"), 295 | subunitwidth = 1, 296 | countrywidth = 1, 297 | subunitcolor = toRGB("white"), 298 | countrycolor = toRGB("black") 299 | ) 300 | 301 | # specify map projection/options 302 | l <- list(color = toRGB("grey95"), width = 0.5) 303 | g2 <- list( 304 | showframe = TRUE, 305 | showcoastlines = TRUE, 306 | projection = list(type = 'Mercator') 307 | ) 308 | 309 | fig <- plot_geo(df2, 310 | hoverinfo = 'text', 311 | text = ~paste( 312 | '
Region: ', country, 313 | '
Cases: ', cases, 314 | '
Deaths: ', deaths, 315 | '
Population: ', population, 316 | '

Date: ', date 317 | ) 318 | ) 319 | fig <- fig %>% add_trace( 320 | # z = as.formula(paste0("~`", input$type, "`")) , 321 | # color = as.formula(paste0("~`", input$type, "`")), colors = 'Reds', 322 | # hoverinfo= as.formula(paste0("~`", input$type, "`")), 323 | z = ~cases, 324 | color = ~cases, 325 | colors = 'Reds', 326 | locations = ~ISO3 327 | ) 328 | fig <- fig %>% colorbar(title = "cases" ) 329 | fig <- fig %>% plotly::layout( 330 | title = ' ', 331 | geo = g 332 | ) 333 | }) 334 | 335 | output$vaccine_table = DT::renderDataTable({ 336 | validate(need( exists("vaccine_data"), "Loading")) 337 | vaccine_data$table[,!colnames(vaccine_data$table) %in% "details"] 338 | },rownames = FALSE ) 339 | 340 | output$therapeutics_table = DT::renderDataTable({ 341 | validate(need( exists("therapeutics_data"), "Loading")) 342 | therapeutics_data$table[,!colnames(therapeutics_data$table) %in% c("details")] 343 | },rownames = FALSE ) 344 | 345 | output$Summary_table1 = DT::renderDataTable({ 346 | validate(need( exists("vaccine_data"), "Loading")) 347 | therapeutics_data$summary 348 | },rownames = FALSE ) 349 | output$Summary_table2 = DT::renderDataTable({ 350 | validate(need( exists("therapeutics_data"), "Loading")) 351 | vaccine_data$summary 352 | },rownames = FALSE ) 353 | 354 | output$active_plot <- renderPlotly({ 355 | validate(need( exists("lastest_data"), "Loading")) 356 | df = lastest_data$detail 357 | df = df[order(df$activePerOneMillion,decreasing = T),] 358 | p <- ggplot(df, aes(country,activePerOneMillion)) + 359 | geom_col(color="firebrick") + scale_x_discrete(limits= df$country) + 360 | geom_hline(yintercept = mean(df$activePerOneMillion)) + 361 | theme_minimal() + ylab("Active cases per million population") + 362 | theme( axis.text.x=element_blank(), 363 | axis.ticks.x=element_blank(), 364 | legend.position = 'none') 365 | ggplotly(p, tooltip = c("country","activePerOneMillion")) 366 | }) 367 | 368 | output$Mortality_plot <- renderPlotly({ 369 | validate(need( exists("lastest_data"), "Loading")) 370 | df = lastest_data$detail 371 | df = df[order(df$deathsPerOneMillion,decreasing = T),] 372 | p <- ggplot(df, aes(country,deathsPerOneMillion)) + 373 | geom_col(color="firebrick") + scale_x_discrete(limits= df$country) + 374 | geom_hline(yintercept = mean(df$deathsPerOneMillion)) + 375 | theme_minimal() + ylab('Mortality per million population') + 376 | theme( axis.text.x=element_blank(), 377 | axis.ticks.x=element_blank(), 378 | legend.position = 'none') 379 | ggplotly(p, tooltip = c("country","deathsPerOneMillion")) 380 | }) 381 | 382 | # cor_plot 383 | output$cor_plot <- renderPlotly({ 384 | validate(need( exists("lastest_data"), "Loading")) 385 | df = lastest_data$detail 386 | x = input$cor_type1 387 | y = input$cor_type2 388 | p = ggplot(df, aes_string(x,y, color="country")) + 389 | geom_jitter() + guides(color = FALSE ) + 390 | theme_minimal() + 391 | labs(subtitle="The size of the dots in the graph corresponds to the number of patients diagnosed today") + 392 | theme( axis.text=element_blank(), 393 | axis.ticks=element_blank(), 394 | legend.position = 'none' ) 395 | }) 396 | # wave_plot 397 | output$wave_plot <- renderPlotly({ 398 | validate(need(input$country_list2, "Pleas choose some countries")) 399 | tmp = subset(a, country %in% input$country_list2) 400 | tmp$Log2Increase = log2(tmp$diff + 1) 401 | tmp$Increase = tmp$diff 402 | p <- ggplot(tmp,aes(date, Log2Increase,color=country, Increase = Increase)) + geom_line() + 403 | labs(y="Daily increase cases(log2 scale)") + 404 | theme(axis.text = element_text(angle = 15, hjust = 1)) + 405 | scale_x_date(date_labels = "%Y-%m-%d") + theme_minimal() 406 | ggplotly(p, tooltip = c("country","date", "Increase")) 407 | }) 408 | ### reflash button 409 | observeEvent(input$reflashButton, { 410 | res <- reflash() 411 | lastest_data=res$lastest 412 | global_data=res$global 413 | historical_data=res$historical 414 | #vaccine_data=res$vaccine 415 | #therapeutics_data=res$therapeutics 416 | }) 417 | ### end 418 | } 419 | 420 | shinyApp(ui = ui, server = server) 421 | --------------------------------------------------------------------------------