Philadelphia_COVID_Dashboard.Rmd

---
title: "Philadelphia COVID-19 Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    theme: bootstrap
runtime: shiny
---

```{r setup, include=FALSE}
# Load all applicable libraries
library(flexdashboard) # For construction of dashboard format
library(readr) # For faster CSV read using read_csv (instead of read.csv)
library(tidyverse) # For access to dplyr and other libraries
library(scales) 
library(highcharter) # Graphing library of choice
library(leaflet) # Mapping library of choice
library(tigris) # Support for Zip Code cacheing 
library(kableExtra) # Graphic table library

source("Init.R") # Most used dataframes come from this initial r-script
```

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

Column {data-width=550}{.tabset .tabset-fade}
-----------------------------------------------------------------------

### **COVID-19 Positive Cases by ZIP (All-Time)**

```{r}
# Cache Zip Code Boundaries via `tigris`
options(tigris_use_cache = TRUE)

char_zips <- zctas(cb = TRUE, starts_with = "191")

df <- COVID.ZIP %>% 
  filter(covid_status == "POS") %>%
  select(zip_code, count)

df$count <- as.integer(df$count)
df$zip_code <- as.character(df$zip_code)

join.df <- geo_join(char_zips, 
                    df, 
                    by_sp = "GEOID10", 
                    by_df = "zip_code",
                    how = "left")

pal <- colorNumeric(
  palette = "Blues",
  domain = join.df$count, na.color = "#808080")

labels <- 
  paste0(
    "Zip Code: ",
    join.df$GEOID10, "<br/>",
    "COVID Positive Count: ",
    join.df$count) %>%
  lapply(htmltools::HTML)


join.df %>% 
  leaflet %>% 
  addProviderTiles(providers$CartoDB.Positron) %>% 
  addPolygons(fillColor = ~pal(count), 
              weight = 2,
              opacity = 1,
              color = "white",
              dashArray = "3",
              fillOpacity = 0.7,
              highlight = highlightOptions(weight = 2,
                                           color = "#666",
                                           dashArray = "",
                                           fillOpacity = 0.7,
                                           bringToFront = TRUE),
              label = labels) %>%
  addLegend(pal = pal,
            values = ~count, 
            opacity = 0.7, 
            title = htmltools::HTML("COVID-19 Positive Count <br> 
                                    by Zip Code"),
            position = "bottomright")

```

### **COVID-19 Deaths by ZIP (All-Time)**

```{r}
# Cache Zip Code Boundaries via `tigris`
options(tigris_use_cache = TRUE)

char_zips <- zctas(cb = TRUE, starts_with = "191")

df <- COVID.DeathZip %>% 
  select(zip_code, count)

df$count <- as.integer(df$count)
df$zip_code <- as.character(df$zip_code)

join.df <- geo_join(char_zips, 
                    df, 
                    by_sp = "GEOID10", 
                    by_df = "zip_code",
                    how = "left")

pal <- colorNumeric(
  palette = "Reds",
  domain = join.df$count, na.color = "#808080")

labels <- 
  paste0(
    "Zip Code: ",
    join.df$GEOID10, "<br/>",
    "COVID Death Count: ",
    join.df$count) %>%
  lapply(htmltools::HTML)


join.df %>% 
  leaflet %>% 
  addProviderTiles(providers$CartoDB.Positron) %>% 
  addPolygons(fillColor = ~pal(count), 
              weight = 2,
              opacity = 1,
              color = "white",
              dashArray = "3",
              fillOpacity = 0.7,
              highlight = highlightOptions(weight = 2,
                                           color = "#666",
                                           dashArray = "",
                                           fillOpacity = 0.7,
                                           bringToFront = TRUE),
              label = labels) %>%
  addLegend(pal = pal,
            values = ~count, 
            opacity = 0.7, 
            title = htmltools::HTML("COVID-19 Death Count <br> 
                                    by Zip Code"),
            position = "bottomright")

```

Column {data-width=150}
-----------------------------------------------------------------------

### COVID-19: Negative

```{r COVID Outcomes - Negative}
valueBox(COVID.Outcome$Count[COVID.Outcome$Outcome == "Negative"], icon = "fa-smile", color = "#3AC409")
```

### COVID-19: Positive

```{r COVID Outcomes - Positive}
valueBox(COVID.Outcome$Count[COVID.Outcome$Outcome == "Positive"], icon = "fa-bug", color = "#E9C509")
```

### COVID-19: Died (w/ Approx. Mortality Rate)

```{r COVID Outcomes - Died}
valueBox(value = paste0(COVID.Outcome$Count[COVID.Outcome$Outcome == "Died"], " (", percent(COVID.Outcome$Count[COVID.Outcome$Outcome == "Died"]/COVID.Outcome$Count[COVID.Outcome$Outcome == "Positive"], accuracy = 0.01),")"), icon = "fa-skull", color = "#DC4015")
```

### Data Query Time Stamp

```{r COVID Time Stamp}
valueBox(value = COVID.Outcome$Timestamp[1], icon = "fa-clock", color = "#3fb5e3")
```

###

```{r, fig.width=10, fig.height=10}
knitr::include_graphics("PHLLetters.JPG")
```

Column {data-width=300}
-----------------------------------------------------------------------
### **Demographic Breakdown**

```{r COVID Gender}
COVID.AgeC %>% 
  select(Age, Gender, Count) %>% 
  kable() %>% 
  kable_styling(c("striped", "condensed", "hover")) %>% 
  column_spec(column = 3, bold = T, color = "#DC4015") %>%
  pack_rows("Outcome: Positive", start_row = 1, end_row = 5, label_row_css = "background-color: #666; color: #fff;") %>% 
  pack_rows("Outcome: Died", start_row = 6, end_row = 12, label_row_css = "background-color: #666; color: #fff;") %>% 
  footnote(general = "Counts are based on all-time totals.")
```

```{r COVID Race}
COVID.Race %>%
  rbind(COVID.DeathRace) %>% 
  select(Race, Count, Percentage) %>% 
  kable() %>% 
  kable_styling(c("striped", "condensed", "hover")) %>% 
  column_spec(column = 3, bold = T, color = "#DC4015") %>%
  pack_rows("Outcome: Positive", start_row = 1, end_row = nrow(COVID.Race), label_row_css = "background-color: #666; color: #fff;") %>% 
  pack_rows("Outcome: Died", start_row = nrow(COVID.Race) + 1, end_row = nrow(COVID.Race) + nrow(COVID.DeathRace), label_row_css = "background-color: #666; color: #fff;") %>% 
  footnote(general = "Counts are based on all-time totals.")
```

Test Result Reporting {.tabset .tabset-fade}
=========================================

Column {data-width=650}{.tabset .tabset-fade}
-----------------------------------------------------------------------

### **Test Results by Date**

```{r COVID Date}
COVID.Date %>%
  arrange(ResultDate) %>% 
  hchart("area", hcaes(x = ResultDate, y = Count, group = Outcome)) %>% 
  hc_add_theme(hc_theme_db()) %>% 
  hc_colors(colors = c("#89DC6B", "#F1431C")) %>%
  hc_chart(zoomType = "xy") %>% 
  hc_title(text = "COVID-19 Test Results by Date") %>% 
  hc_exporting(enabled = TRUE, filename = "COVID19_Incidence_Plot") %>% 
  hc_yAxis(title = list(text = "Count (n)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_xAxis(title = list(text = "Date (Test Results Per Day)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_credits(enabled = TRUE, text = "Source: https://www.opendataphilly.org/dataset/covid-cases")
```

### **Death Toll by Date**

```{r COVID Date Death}
COVID.DeathDate %>%
  arrange(ResultDate) %>% 
  hchart("area", hcaes(x = ResultDate, y = Count, group = Outcome)) %>% 
  hc_add_theme(hc_theme_db()) %>% 
  hc_colors(colors = c("#F1431C")) %>%
  hc_chart(zoomType = "xy") %>% 
  hc_title(text = "COVID-19 Death Counts by Date") %>% 
  hc_exporting(enabled = TRUE, filename = "COVID19_Incidence_Plot") %>% 
  hc_yAxis(title = list(text = "Count (n)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_xAxis(title = list(text = "Date (Death Count Per Day)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_credits(enabled = TRUE, text = "Source: https://www.opendataphilly.org/dataset/covid-cases")
```

### **7-Day Rolling Averages**

```{r COVID 7 Day Roll Avg}
roll.wk %>%
  arrange(ResultDate) %>%
  drop_na() %>% 
  hchart("area", hcaes(x = ResultDate, y = RollWindow, group = Outcome)) %>% 
  hc_add_theme(hc_theme_db()) %>% 
  hc_colors(colors = c("#F1431C", "#89DC6B", "#E7B53C")) %>%
  hc_chart(zoomType = "xy") %>% 
  hc_title(text = "COVID-19 7-Day Rolling Average") %>% 
  hc_exporting(enabled = TRUE, filename = "COVID19_Rolling_Avg_Plot") %>% 
  hc_yAxis(title = list(text = "Count (n)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_xAxis(title = list(text = "Date (Avg. of Preceding 7 Days)", style = list(fontSize = "16px", color = "white")),
           labels = list(style = list(fontSize = "12px", color = "white"))) %>% 
  hc_credits(enabled = TRUE, text = "Source: https://www.opendataphilly.org/dataset/covid-cases")
```

Column {data-width=250}
-----------------------------------------------------------------------

### Approx. **Male** Mortality Rate (All-Time)

```{r COVID Mortality - Male}
valueBox(percent(COVID.Gender$Count[COVID.Gender$Gender == "Male" & COVID.Gender$Outcome == "Died"]/COVID.Gender$Count[COVID.Gender$Gender == "Male" & COVID.Gender$Outcome == "Positive"], .01), icon = "fa-male", color = "#e67904")
```

### Approx. **Female** Mortality Rate (All-Time)

```{r COVID Mortality - Female}
valueBox(percent(COVID.Gender$Count[COVID.Gender$Gender == "Female" & COVID.Gender$Outcome == "Died"]/COVID.Gender$Count[COVID.Gender$Gender == "Female" & COVID.Gender$Outcome == "Positive"], .01), icon = "fa-female", color = "#5f9bf3")
```

### COVID-19 Gender Breakdown
```{r Gender Table}
COVID.Gender %>% 
  arrange(Gender) %>% 
  kable() %>% 
  kable_styling(c("striped", "condensed", "hover")) %>% 
  column_spec(3, bold = T, color = "#DC4015") %>% 
  footnote(general = "Counts are based on all-time totals. Gender identification is resprentative of recorded data and not a depiction of pronoun bias.")
```

###

```{r, fig.width=10, fig.height=10}
knitr::include_graphics("PhillyMap.jpg")
```

User Information
=========================================

<span style="color: #008cba; font-size:18px;">**Introduction**</span>

Welcome to the **Philadelphia COVID-19 Dashboard**. This dashboard was built with the intention of displaying day-by-day metrics of COVID-19 prevalence and demographic impact in the city of Philadelphia, Pennsylvania. It is made using the [R statistical programming language](https://www.r-project.org/about.html) with functionality provided by the `flexdashboard` package, `highcharter` graphing library, among others.

This dashboard and the code associated are made freely available on the author’s [GitHub repository](https://github.com/rsh52/COVID_Research).

<span style="color: #008cba; font-size:18px ">**Background**</span>

As described by the CDC, COVID-19 is the resultant respiratory illness of the Sars-Cov-2 virus. The virus was first seen on a global stage in December, 2019 though some evidence suggests the true start date with patient zero was sometime in November. Named after the Latin word for “crown” due to the resemblance of the virus’ surface, coronaviruses come in varying forms including SARS and MERS from outbreaks in the past. The novel Sars-Cov-2 virus originated in Wuhan, China and made landfall in the United States on January 20th, 2020. On March 11th, the WHO declared COVID-19 a pandemic as the virus touched down in nearly every country around the globe to varying reporting accuracy. 

<span style="color: #008cba; font-size:18px ">**Data Source**</span>

This dashboard takes data from [Open Data Philly](https://www.opendataphilly.org/), a free to use and publicly accessible data source supplying datasets and API integrations for over 300 datasets related to the Philadelphia region. The COVID-19 specific data fed to this dashboard is updated daily and includes de-identified counts of test results, outcomes, location, and age demographics in the region. Data is supplied from two main datasets: [COVID Cases](https://www.opendataphilly.org/dataset/covid-cases) and [COVID Deaths](https://www.opendataphilly.org/dataset/covid-deaths).

<span style="color: #008cba; font-size:18px ">**Limitations**</span>

The true nature of scientific discovery and research lies in the acceptance that tomorrow will only shed more light on the knowledge gleaned today. As events unfold and understanding grows, expect details and data related to COVID-19 to remain in flux for a considerable time. That being said, this dashboard is tied to the same limitations as the rest of the scientific community and a few more:

- Data reported on can only be based on that which is submitted. Therefore, closed testing sites, inaccessibility to communities, or underreported outcomes will not be reflected in this dashboard.
- Past data can change. As more information is brought to light, results may be updated to accommodate.
- This data is specific to the Philadelphia, Pennsylvania region only. It cannot be extrapolated to other areas of the country or the globe.
- Data presented is primarily based on total, all-time counts and is not representative of time series displays with the exception of the two line graphs depicting counts over time as a daily total under the **Test Result Reporting** tab
- Rates of mortality are crude estimates based on the presented all-time data

<span style="color: #e67904; font-size:16px ">**Additional Resources **</span>

- **[Centers for Disease Control and Prevention](https://www.cdc.gov/coronavirus/2019-ncov/index.html)**
- **[World Health Organization](https://www.who.int/emergencies/diseases/novel-coronavirus-2019)**
- **[Johns Hopkins COVID-19 Dashboard](https://coronavirus.jhu.edu/map.html)**
- **[National Public Radio COVID-19 Tracker](https://www.npr.org/sections/health-shots/2020/03/16/816707182/map-tracking-the-spread-of-the-coronavirus-in-the-u-s)**
- **[Children’s Hospital of Philadelphia COVID Tracker and Predictor](https://policylab.chop.edu/covid-lab-mapping-covid-19-your-community)**
- **[Our world in Data Epidemiologic Tracking](https://ourworldindata.org/epi-curve-covid-19)**