The Coronavirus Dashboard
This Coronavirus dashboard provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic. This dashboard is built with R using the Rmakrdown framework and can easily reproduce by others. The code behind the dashboard available here
Data
The input data for this dashboard is the coronavirus R package (dev version). The data and dashboard is refreshed on a daily bases. The raw data pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus repository
Packages
Deployment and reproducibly
The dashboard was deployed to Github docs. If you wish to deploy and/or modify the dashboard on your Github account, you can apply the following steps:
For any question or feedback, you can either open an issue or contact me on Twitter.
---
title: "Coronavirus"
output:
flexdashboard::flex_dashboard:
orientation: rows
social: menu
source_code: embed
vertical_layout: fill
---
```{r setup, include=FALSE}
#------------------ Packages ------------------
library(flexdashboard)
library(coronavirus)
data(coronavirus)
`%>%` <- magrittr::`%>%`
#------------------ Parameters ------------------
# Set colors
# https://www.w3.org/TR/css-color-3/#svg-color
confirmed_color <- "purple"
active_color <- "#1f77b4"
recovered_color <- "forestgreen"
death_color <- "red"
#------------------ Data ------------------
df <- coronavirus %>%
# dplyr::filter(date == max(date)) %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total = sum(cases)) %>%
tidyr::pivot_wider(names_from = type,
values_from = total) %>%
dplyr::mutate(unrecovered = confirmed - ifelse(is.na(recovered), 0, recovered) - ifelse(is.na(death), 0, death)) %>%
dplyr::arrange(-confirmed) %>%
dplyr::ungroup() %>%
dplyr::mutate(country = dplyr::if_else(Country.Region == "United Arab Emirates", "UAE", Country.Region)) %>%
dplyr::mutate(country = dplyr::if_else(country == "Mainland China", "China", country)) %>%
dplyr::mutate(country = dplyr::if_else(country == "North Macedonia", "N.Macedonia", country)) %>%
dplyr::mutate(country = trimws(country)) %>%
dplyr::mutate(country = factor(country, levels = country))
df_daily <- coronavirus %>%
dplyr::group_by(date, type) %>%
dplyr::summarise(total = sum(cases, na.rm = TRUE)) %>%
tidyr::pivot_wider(names_from = type,
values_from = total) %>%
dplyr::arrange(date) %>%
dplyr::ungroup() %>%
dplyr::mutate(active = confirmed - death - recovered) %>%
dplyr::mutate(confirmed_cum = cumsum(confirmed),
death_cum = cumsum(death),
recovered_cum = cumsum(recovered),
active_cum = cumsum(active))
df1 <- coronavirus %>% dplyr::filter(date == max(date))
```
Summary
=======================================================================
Row
-----------------------------------------------------------------------
### confirmed {.value-box}
```{r}
valueBox(value = paste(format(sum(df$confirmed), big.mark = ","), "", sep = " "),
caption = "Total Confirmed Cases",
icon = "fas fa-user-md",
color = confirmed_color)
```
### active {.value-box}
```{r}
valueBox(value = paste(format(sum(df$unrecovered, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$unrecovered, na.rm = TRUE) / sum(df$confirmed), 1),
"%)", sep = ""),
caption = "Active Cases", icon = "fas fa-ambulance",
color = active_color)
```
### recovered {.value-box}
```{r}
valueBox(value = paste(format(sum(df$recovered, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$recovered, na.rm = TRUE) / sum(df$confirmed), 1),
"%)", sep = ""),
caption = "Recovered Cases", icon = "fas fa-heartbeat",
color = recovered_color)
```
### death {.value-box}
```{r}
valueBox(value = paste(format(sum(df$death, na.rm = TRUE), big.mark = ","), " (",
round(100 * sum(df$death, na.rm = TRUE) / sum(df$confirmed), 1),
"%)", sep = ""),
caption = "Death Cases",
icon = "fas fa-heart-broken",
color = death_color)
```
Row
-----------------------------------------------------------------------
### Total Cases by Type/Country
```{r daily_summary}
plotly::plot_ly(data = df,
x = ~ country,
y = ~ unrecovered,
# text = ~ confirmed,
# textposition = 'auto',
type = "bar",
name = "Active",
marker = list(color = active_color)) %>%
plotly::add_trace(y = ~ recovered,
# text = ~ recovered,
# textposition = 'auto',
name = "Recovered",
marker = list(color = recovered_color)) %>%
plotly::add_trace(y = ~ death,
# text = ~ death,
# textposition = 'auto',
name = "Death",
marker = list(color = death_color)) %>%
plotly::layout(barmode = 'stack',
yaxis = list(title = "Total Cases (log scaled)",
type = "log"),
xaxis = list(title = ""),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
))
```
Row {data-width=400}
-----------------------------------------------------------------------
### Daily Cumulative Cases by Type
```{r}
# plotly::plot_ly(df_daily, x = ~date, y = ~active_cum, name = 'Active', type = 'scatter', mode = 'none', stackgroup = 'one', fillcolor = "#1f77b4") %>%
# plotly::add_trace(y = ~recovered_cum, name = 'Recovered', fillcolor = "green") %>%
# plotly::add_trace(y = ~death_cum, name = "Death", fillcolor = "red") %>%
# plotly::layout(title = "",
# xaxis = list(title = "",
# showgrid = FALSE),
# yaxis = list(title = "Cumulative Number of Cases",
# showgrid = FALSE),
# legend = list(x = 0.1, y = 0.9),
# hovermode = "compare")
plotly::plot_ly(data = df_daily) %>%
plotly::add_trace(x = ~ date,
y = ~ active_cum,
type = "scatter",
mode = "lines+markers",
name = "Active",
line = list(color = active_color),
marker = list(color = active_color)) %>%
plotly::add_trace(x = ~ date,
y = ~ recovered_cum,
type = "scatter",
mode = "lines+markers",
name = "Recovered",
line = list(color = recovered_color),
marker = list(color = recovered_color)) %>%
plotly::add_trace(x = ~ date,
y = ~ death_cum,
type = "scatter",
mode = 'lines+markers',
name = "Death",
line = list(color = death_color),
marker = list(color = death_color)) %>%
plotly::add_annotations(x = as.Date("2020-03-01"),
y = 42716,
text = paste("# of recovered cases surpass",
"",
"the # of active cases"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -10,
ay = 90) %>%
plotly::layout(title = "",
yaxis = list(title = "Cumulative Number of Cases"),
xaxis = list(title = "Date"),
legend = list(x = 0.1, y = 0.9),
hovermode = "compare")
```
### Recovery and Death Rates by Country
```{r}
df_summary <-coronavirus %>%
# dplyr::filter(Country.Region != "Others") %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total_cases = sum(cases)) %>%
tidyr::pivot_wider(names_from = type, values_from = total_cases) %>%
dplyr::arrange(- confirmed) %>%
dplyr::filter(confirmed >= 25) %>%
dplyr::select(country = Country.Region, confirmed, recovered, death) %>%
dplyr::mutate(recover_rate = recovered / confirmed,
death_rate = death / confirmed)
df_summary %>%
DT::datatable(rownames = FALSE,
colnames = c("Country", "Confirmed", "Recovered", "Death", "Recovery Rate", "Death Rate"),
options = list(pageLength = nrow(df_summary), dom = 'tip')) %>%
DT::formatPercentage("recover_rate", 2) %>%
DT::formatPercentage("death_rate", 2)
```
Trends
=======================================================================
Column {data-width=400}
-------------------------------------
### New Cases - Top 15 Countries (`r max(coronavirus$date)`)
```{r}
max_date <- max(coronavirus$date)
coronavirus %>%
dplyr::filter(type == "confirmed", date == max_date) %>%
dplyr::group_by(Country.Region) %>%
dplyr::summarise(total_cases = sum(cases)) %>%
dplyr::arrange(-total_cases) %>%
dplyr::mutate(country = factor(Country.Region, levels = Country.Region)) %>%
dplyr::ungroup() %>%
dplyr::top_n(n = 15, wt = total_cases) %>%
plotly::plot_ly(x = ~ country,
y = ~ total_cases,
text = ~ total_cases,
textposition = 'auto',
type = "bar") %>%
plotly::layout(yaxis = list(title = "Number of Cases"),
xaxis = list(title = ""),
margin = list(
l = 10,
r = 10,
b = 10,
t = 10,
pad = 2
))
```
### Daily New Cases - China vs. Rest of the World
```{r}
daily_confirmed <- coronavirus %>%
dplyr::filter(type == "confirmed") %>%
dplyr::mutate(country = dplyr::if_else(Country.Region == "Mainland China",
"China",
"Rest of the World")) %>%
dplyr::group_by(date, country) %>%
dplyr::summarise(total = sum(cases)) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = country, values_from = total)
#----------------------------------------
# Plotting the data
daily_confirmed %>%
plotly::plot_ly() %>%
plotly::add_trace(x = ~ date,
y = ~ China,
type = "scatter",
mode = "lines+markers",
name = "China") %>%
plotly::add_trace(x = ~ date,
y = ~ `Rest of the World`,
type = "scatter",
mode = "lines+markers",
name = "Rest of the World") %>%
plotly::add_annotations(x = as.Date("2020-02-13"),
y = 15133,
text = paste("One time adjustment -",
"",
"China modified the diagnostic criteria"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = 50,
ay = -40) %>%
plotly::add_annotations(x = as.Date("2020-02-26"),
y = 577,
text = paste("New cases outside of China", "", "surpass the ones inside China"),
xref = "x",
yref = "y",
arrowhead = 5,
arrowhead = 3,
arrowsize = 1,
showarrow = TRUE,
ax = -70,
ay = -50) %>%
plotly::layout(title = "",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of New Cases"),
xaxis = list(title = "Date"),
# paper_bgcolor = "black",
# plot_bgcolor = "black",
# font = list(color = 'white'),
hovermode = "compare",
margin = list(
# l = 60,
# r = 40,
b = 10,
t = 10,
pad = 2
))
```
Column {data-width=600}
-------------------------------------
### Recovery and Death Rates for Countries with at Least 25 Cases
```{r}
coronavirus::coronavirus %>%
# dplyr::filter(Country.Region != "Others") %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total_cases = sum(cases)) %>%
tidyr::pivot_wider(names_from = type, values_from = total_cases) %>%
dplyr::arrange(- confirmed) %>%
dplyr::filter(confirmed >= 25) %>%
dplyr::mutate(recover_rate = recovered / confirmed,
death_rate = death / confirmed) %>%
dplyr::mutate(recover_rate = dplyr::if_else(is.na(recover_rate), 0, recover_rate),
death_rate = dplyr::if_else(is.na(death_rate), 0, death_rate)) %>%
dplyr::ungroup() %>%
dplyr::mutate(confirmed_normal = as.numeric(confirmed) / max(as.numeric(confirmed))) %>%
plotly::plot_ly(y = ~ round(100 * recover_rate, 1),
x = ~ round(100 * death_rate, 1),
size = ~ log(confirmed),
sizes = c(5, 70),
type = 'scatter', mode = 'markers',
color = ~ Country.Region,
marker = list(sizemode = 'diameter' , opacity = 0.5),
hoverinfo = 'text',
text = ~paste("", Country.Region,
" Confirmed Cases: ", confirmed,
" Recovery Rate: ", paste(round(100 * recover_rate, 1), "%", sep = ""),
" Death Rate: ", paste(round(100 * death_rate, 1), "%", sep = ""))
) %>%
plotly::layout(yaxis = list(title = "Recovery Rate", ticksuffix = "%"),
xaxis = list(title = "Death Rate", ticksuffix = "%",
dtick = 1,
tick0 = 0),
hovermode = "compare")
```
### Cases Status Update for `r max(coronavirus$date)`
```{r}
coronavirus %>%
dplyr::filter(date == max(date)) %>%
dplyr::group_by(Country.Region, type) %>%
dplyr::summarise(total = sum(cases)) %>%
tidyr::pivot_wider(names_from = type, values_from = total) %>%
dplyr::arrange(-confirmed) %>%
DT::datatable(rownames = FALSE,
colnames = c("Country", "Confirmed", "Recovered", "Death"),
options = list(pageLength = 10, dom = 'tip'))
```
Data
=======================================================================
```{r}
coronavirus %>%
dplyr::select(Date = date, Province = Province.State, Country = Country.Region, `Case Type` = type, `Number of Cases` = cases) %>%
DT::datatable(rownames = FALSE,
options = list(searchHighlight = TRUE,
pageLength = 20), filter = 'top')
```
About
=======================================================================
**The Coronavirus Dashboard**
This Coronavirus dashboard provides an overview of the 2019 Novel Coronavirus COVID-19 (2019-nCoV) epidemic. This dashboard is built with R using the Rmakrdown framework and can easily reproduce by others. The code behind the dashboard available [here](https://github.com/RamiKrispin/coronavirus_dashboard)
**Data**
The input data for this dashboard is the [coronavirus](https://github.com/RamiKrispin/coronavirus) R package (dev version). The data and dashboard is refreshed on a daily bases. The raw data pulled from the Johns Hopkins University Center for Systems Science and Engineering (JHU CCSE) Coronavirus [repository](https://github.com/RamiKrispin/coronavirus-csv)
**Packages**
* Dashboard interface - the [flexdashboard](https://rmarkdown.rstudio.com/flexdashboard/) package.
* Visualization - the [plotly](https://plot.ly/r/) package
* Data manipulation - [dplyr](https://dplyr.tidyverse.org/), and [tidyr](https://tidyr.tidyverse.org/)
* Tables - the [DT](https://rstudio.github.io/DT/) package
**Deployment and reproducibly**
The dashboard was deployed to Github docs. If you wish to deploy and/or modify the dashboard on your Github account, you can apply the following steps:
* Fork the dashboard [repository](https://github.com/RamiKrispin/coronavirus_dashboard), or
* Clone it and push it to your Github package
* Here some general guidance about deployment of flexdashboard on Github page - [link](https://github.com/pbatey/flexdashboard-example)
For any question or feedback, you can either open an [issue](https://github.com/RamiKrispin/coronavirus_dashboard/issues) or contact me on [Twitter](https://twitter.com/Rami_Krispin).