Overview

Row

confirmed

172,871,377

active

52,341,590 (30.3%)

recovered

116,810,804 (67.6%)

death

3,718,983 (2.2%)

Row

Map of Cases

Daily

Column

Daily Cumulative Cases

Histogram of Daily Cases

Top 20 Countries

Column

Confirmed Cases

Death Cases

Active Cases

Cases Data

Vaccination

Row

Total Doses

2,121,290,083

At least one

894,703,785

People Fully vaccinated

457,724,335

Column

Map

Top 20

Vaccination data

About

This dashboard provides an overview of the COVID-19 (2019-nCoV) epidemic. This dashboard was built with R using Rmarkdown and the Flexdashboard package. The Github Repository for this dashboard available here

Data

The source of data for this dashboard is from the R package coronavirus. With the raw data pulled from the COVID-19 Data Repository by the Center for Systems Science and Engineering (CSSE) at Johns Hopkins University

The source of vaccination data can be found at the Our World in Data vaccination github repo

Packages

Update

---
title: "COVID-19 Dashboard"
output: 
  flexdashboard::flex_dashboard:
    theme: flatly
    orientation: rows
    social: menu
    source_code: embed
    vertical_layout: fill
---

      

```{r, include=FALSE, warnings=FALSE, message=FALSE}
knitr::opts_chunk$set(message = FALSE, warning=FALSE)
```

```{r dependencies, include=FALSE, warnings=FALSE, message=FALSE}
#------------------ Packages ------------------
## For Dashboard
library(flexdashboard)

## Data cleaning 
library(data.table)
library(dplyr)
library(tidyr)
library(magrittr)
library(purrr)
library(forcats)

## printing 
library(glue)

## Maps and Plots
library(plotly)
library(leaflet)
library(leafpop)
library(RColorBrewer)

# Dates
library(lubridate)

## For displaying tables
library(DT)

theme_set(theme_classic())
```

```{r cases_data}
#------------------ Data ------------------
url <- "https://raw.githubusercontent.com/RamiKrispin/coronavirus/master/csv/coronavirus.csv"
df <- fread(url) %>%
    mutate(
        country = trimws(country),
        country = factor(country, levels = unique(country))
    )

# for time series plot
df_daily <- df %>%
    group_by(date, type) %>%
    summarise(total = sum(cases, na.rm = T), .groups = "drop") %>%
    pivot_wider(names_from = type,
                values_from = total) %>%
    arrange(date) %>%
    ungroup() %>%
    mutate(active =  confirmed - death - recovered) %>%
    mutate(
        confirmed_cum = cumsum(confirmed),
        death_cum = cumsum(death),
        recovered_cum = cumsum(recovered),
        active_cum = cumsum(active)
    )

df_country <- df %>%
    group_by(country, type) %>%
    summarise(total = sum(cases), .groups = "drop") %>%
    pivot_wider(names_from = type, values_from = total) %>%
    mutate(active = confirmed - death - recovered) %>%
    pivot_longer(cols = -country,
                 names_to = "type",
                 values_to = "total")

# for global statistics
df_world <- df_country %>%
    group_by(type) %>%
    summarise(total = sum(total), .groups = "drop") %>%
    pivot_wider(names_from = type, values_from = total)

# for leaflet map
df_map <- df %>%
    filter(cases > 0) %>%
    group_by(country, province, lat, long, type) %>%
    summarise(cases = sum(cases), .groups = "drop") %>%
    mutate(log_cases = 2 * log(cases)) %>%
    ungroup()

df_map.split <- df_map %>%
    split(df_map$type)
```


```{r vax_data}
# Vaccination Data

url2 <- "https://raw.githubusercontent.com/owid/covid-19-data/master/public/data/vaccinations/vaccinations.csv"

df_vax <- fread(url2) %>% 
  replace(is.na(.), 0) %>% 
  mutate(location = factor(location, levels = unique(location))) %>% 
  as_tibble()

# glimpse(df_vacc)

## daily vaccinations
df_vax_daily <- df_vax %>% 
  select(date, location, daily_vaccinations) %>% 
  group_by(location, date) %>% 
  summarise(total = sum(daily_vaccinations), .groups="drop") %>%
  filter(location != "World") %>% 
  arrange(-total) %>%
  pivot_wider(names_from = date, values_from = total) %>%
  # replace(is.na(.), 0) %>% 
  # mutate(across(where(is.numeric), log)) %>% 
  slice(1:20) %>% 
  pivot_longer(cols = -location, 
               names_to = "date", 
               values_to = "total") %>% 
  mutate(date = ymd(date)) 


# world statistics
df_world_vax <- df_vax %>% 
  select(location,
         total_vaccinations,
         people_vaccinated,
         people_fully_vaccinated,
  ) %>% 
  filter(location == "World") %>% 
  summarise(total_vax = max(total_vaccinations),
            ppl_once = max(people_vaccinated),
            fully_vax = max(people_fully_vaccinated)) %>% 
  mutate(across(where(is.numeric), scales::comma))

# total vaccines administered
df_vax_total <- df_vax %>% 
  select(location, iso_code, total_vaccinations) %>% 
  group_by(location) %>% 
  filter(total_vaccinations == max(total_vaccinations), location != "World") 
```


Overview
=======================================================================

Row
-----------------------------------------------------------------------

### confirmed {.value-box}

```{r}
confirmed <- format(df_world$confirmed, big.mark = ",")
valueBox(value = confirmed, 
         caption = "Total Confirmed Cases", 
         color = "black")
```


### active {.value-box}

```{r}
active <- format(df_world$active, big.mark = ",")
active_perc <- round(100 * df_world$active / df_world$confirmed, 1)

valueBox(
    value = glue("{active} ({active_perc}%)"),
    caption = "Active Cases",
    color = "blue"
)
```

### recovered {.value-box}

```{r}
recovered <- format(df_world$recovered, big.mark = ",")
recovered_perc <-
    round(100 * df_world$recovered / df_world$confirmed, 1)

valueBox(
    value = glue("{recovered} ({recovered_perc}%)"),
    caption = "Recovered Cases",
    color = "green"
)
```

### death {.value-box}

```{r}
death <- format(df_world$death, big.mark = ",")
death_perc <- round(100 * df_world$death / df_world$confirmed, 1)

valueBox(
    value = glue("{death} ({death_perc}%)"),
    caption = "Death Cases",
    color = "red"
)
```


Row {.tabset}
-----------------------------------------------------------------------

### Map of Cases

```{r}
# Color pallete
pal <- colorFactor(c("grey", "red", "green"),
                   domain = c("confirmed", "death", "recovered"))

map_object <- leaflet() %>%
    addProviderTiles(providers$CartoDB.DarkMatter) %>% 
    setView(41.405559, 0.247590, zoom=2)

names(df_map.split) %>%
  walk(function(df) {
    map_object <<- map_object %>%
      addCircleMarkers(data=df_map.split[[df]],
                 lng=~long, lat=~lat,
                 color = ~pal(type),
                 stroke = FALSE,
                 fillOpacity = 0.5,
                 radius = ~log_cases,
                 popup =  popupTable(df_map.split[[df]],
                                              feature.id = FALSE,
                                              row.numbers = FALSE,
                                              zcol=c("type","cases","country","province")),
                 group = df,
                 labelOptions = labelOptions(noHide = F,
                                             direction = 'auto'))
  })

map_object %>%
  addLayersControl(
    overlayGroups = names(df_map.split),
    options = layersControlOptions(collapsed = FALSE)) %>% 
    hideGroup(c("confirmed", "recovered"))
```


Daily 
=======================================================================

Column {data-width=400}
-------------------------------------

### Daily Cumulative Cases
    
```{r}
fig <- plot_ly(
    data = df_daily,
    x = ~ date,
    y = ~ active_cum,
    name = "Active",
    fillcolor = "blue",
    type = "scatter",
    mode = "none",
    stackgroup = "one") %>%
    add_trace(y = ~ recovered_cum,
              name = "Recovered",
              fillcolor = "green") %>%
    add_trace(y = ~ death_cum,
              name = "Death",
              fillcolor = "red") %>%
    layout(
        title = "",
        yaxis = list(title = "Cumulative Number of Cases"),
        xaxis = list(title = "Date",
                     type = "date"),
        legend = list(x = 0.1, y = 0.9),
        hovermode = "compare"
    )
fig
```


### Histogram of Daily Cases

```{r}
g <- ggplot(data=df_daily, aes(date, confirmed)) +
    geom_histogram(stat="identity") +
    scale_y_continuous(labels = scales::label_number_si())

ggplotly(g)
```


Top 20 Countries
=======================================================================

Column {.tabset}
-------------------------------------

```{r}
top_20 <- df_country %>% 
    group_by(country, type) %>% 
    pivot_wider(names_from = type, values_from=total) %>% 
    arrange(-confirmed) %>% 
    ungroup() %>% 
    top_n(20)

# top_20  %>%
#     kbl() %>%
#     kable_styling(
#         bootstrap_options = c("striped", "hover", "condensed", "responsive"),
#         position = "left",
#         full_width = F
#     ) %>% 
#     scroll_box(width = "100%", height = "100%")

# define 20 colors with colorRampPalette
nb.cols <- 20
mycolors <- colorRampPalette(brewer.pal(10, "RdYlGn"))(nb.cols)
```

### Confirmed Cases
```{r}
confirmed <- top_20 %>% 
    mutate(country = fct_reorder(country, confirmed)) %>% 
    ggplot(top_20, mapping = aes(x=country, y=confirmed, fill=country)) + 
    geom_bar(stat='identity') +
    theme(legend.position = 'none') +
    scale_fill_manual(values = rev(mycolors)) +
    scale_y_continuous(labels = scales::label_number_si()) +
    labs(y="confirmed cases", x="") +
    coord_flip() +
    ggtitle("Top 20 countries for Confirmed Cases")

ggplotly(confirmed, tooltip="confirmed")
```

### Death Cases
```{r}
death <- top_20 %>% 
    mutate(country = fct_reorder(country, death)) %>% 
    ggplot(top_20, mapping = aes(x=country, y=death, fill=country)) + 
    geom_bar(stat='identity') +
    theme(legend.position = 'none') +
    scale_fill_manual(values = rev(mycolors)) +
    scale_y_continuous(labels = scales::label_number_si()) +
    labs(y="Death Cases", x="") +
    coord_flip() +
    ggtitle("Top 20 countries for Death Cases")

ggplotly(death, tooltip="death")  
```

### Active Cases

```{r}
active<- top_20 %>% 
    mutate(country = fct_reorder(country, active)) %>% 
    ggplot(top_20, mapping = aes(x=country, y=active, fill=country)) + 
    geom_bar(stat='identity') +
    theme(legend.position = 'none') +
    scale_fill_manual(values = rev(mycolors)) +
    scale_y_continuous(labels = scales::label_number_si()) +
    labs(y="Active Cases", x="") +
    coord_flip() +
    ggtitle("Top 20 countries for Active Cases")

ggplotly(active, tooltip="active")
```

### Cases Data

```{r}
df %>%
  group_by(country, type) %>%
  summarise(total = sum(cases), .groups = "drop") %>%
  pivot_wider(names_from = type, values_from = total) %>%
  mutate(active = confirmed - death - recovered) %>%
  datatable(options = list(
    bPaginate = FALSE,
    scrollX = TRUE,
    columnDefs = list(list(className = 'dt-center', targets = "_all"))
  ),
  rownames=FALSE,
  caption = 'Cases Data',
  style = 'bootstrap', 
  class = 'cell-border stripe')
```

Vaccination 
=======================================================================

Row
-----------------------------------------------------------------------

### Total Doses {.value-box}

```{r}
valueBox(value = df_world_vax$total_vax,
         caption = "Total doses administered",
         color = "#228B22")
```


### At least one {.value-box}

```{r}
valueBox(value = df_world_vax$ppl_once,
         caption = "No. of people vaccinated (at least one dose)",
         color = "#228B22")
```


### People Fully vaccinated {.value-box}

```{r}
valueBox(value = df_world_vax$fully_vax, 
         caption = "No. of people fully vaccinated", 
         color = "#228B22")
```


Column {.tabset}
-----------------------------------------------------------------------

```{r}
# scales::number(total, big.mark = "", accuracy = 1))
# vax_daily <-
#   ggplot(df_vax_daily, aes(x = date, y = total, color = location, )) +
#   geom_line() +
#   theme(legend.position = 'none') +
#   scale_colour_manual(values = mycolors) +
#   scale_x_date(date_labels = "%b %d") +
#   scale_y_continuous(labels = scales::label_number()) +
#   ggtitle("Daily COVID-19 vaccine doses administered")
# 
# ggplotly(vax_daily)
```

### Map

```{r}
# figure out how to use iso code to create leaflet maps
# https://www.r-graph-gallery.com/183-choropleth-map-with-leaflet.html

# Plotly choroplet map
# https://plotly.com/r/choropleth-maps/
# light grey boundaries
l <- list(color = toRGB("grey"), width = 0.5)

# specify map projection/options
g <- list(
  showframe = FALSE,
  showcoastlines = FALSE,
  projection = list(type = 'Mercator')
)
# add trace
vax_map <- plot_geo(df_vax_total)
vax_map <- vax_map %>% add_trace(
  z = ~ total_vaccinations,
  color = ~ total_vaccinations,
  colors = 'Greens',
  text = ~ location,
  locations = ~ iso_code,
  marker = list(line = l)
)

# add title to colorbar
vax_map <- vax_map %>% colorbar(title = 'Total vaccinations (M)')

# add title and subtitle
vax_map <- vax_map %>%
  layout(title = 'Total COVID-19 Vaccination Doses Administered
Source:Our World in Data', geo = g)

vax_map
```

### Top 20

```{r}
# for limits of graph
max = arrange(df_vax_total, -total_vaccinations)$total_vaccinations[1]

vax_total <- df_vax_total %>%
  arrange(-total_vaccinations) %>% 
  ungroup() %>% 
  slice(1:20) %>% 
  mutate(location = fct_reorder(location, total_vaccinations)) %>%
  ggplot(aes(
    x = total_vaccinations,
    y = location,
    fill = location,
    label = scales::label_number_si(accuracy = 0.01)(total_vaccinations)
  )) + 
  geom_bar(stat = "identity") +
  geom_text(color="grey50", size = 4) +
  theme(legend.position = 'none') +
  scale_fill_manual(values = mycolors) +
  scale_x_continuous(labels = scales::label_number_si(), limits = c(0, max+20e6)) +
  labs(x="total vaccinations", y="")

ggplotly(vax_total) %>% 
  style(hoverinfo = "none", textposition = "right")
```

### Vaccination data
```{r}
df_vax_total %>% 
  select(location, total_vaccinations) %>% 
  datatable(options = list(
    bPaginate = FALSE,
    scrollX = TRUE,
    columnDefs = list(list(className = 'dt-center', targets = "_all"))
  ),
  rownames=FALSE,
  caption = 'Vaccination Data',
  style = 'bootstrap', 
  class = 'cell-border stripe')
```

About
=======================================================================

This dashboard provides an overview of the COVID-19 (2019-nCoV) epidemic. This dashboard was built with R using Rmarkdown and the Flexdashboard package. The Github Repository for this dashboard available [here](https://github.com/benthecoder/covid19-flexdashboard)

**Data**

The source of data for this dashboard is from the R package [coronavirus](https://github.com/RamiKrispin/coronavirus). With the raw data pulled from the [COVID-19 Data Repository by the Center for Systems Science and Engineering (CSSE) at Johns Hopkins University](https://github.com/CSSEGISandData/COVID-19)

The source of vaccination data can be found at the Our World in Data [vaccination github repo](https://github.com/owid/covid-19-data/tree/master/public/data/vaccinations)

**Packages**

* Dashboard interface - `flexdashboard`
* Visualization - `plotly`, `RColorBrewer`, `ggplot2`
* Data Import - `data.table`
* Data manipulation - `dplyr`, `tidyr`, `purrr`, `forcats`
* Mapping - `leaflet`, `leafpop` 
* Strings - `glue`
* Data Source - `coronavirus`
* Data display - `DT`
* Dates - `lubridate`
* Scales - `scales`

**Update**

* This dashboard was last updated at **`r paste0(format(Sys.time(), "%A, %B %d %Y at %X"), " (", Sys.timezone(), ")")`**
* The latest date from the data is **`r max(df$date)`**
* The latest date from the vaccination data is **`r max(df_vax$date)`**