273,279,951
121,291,289
158,270,895
19,576,303
8,844,250
11,417,538
The city of San Antonio has set up a drive-thru mass vaccination hub at the Alamodome. Though vaccine availability continues to increase, appointments may still be required to receive vaccination. Please visit the city of San Antonio’s COVID-19 Vaccination web page for more information on registering for an appointment.
---
title: "COVID-19 Vaccine Dashboard"
author: "Daniel Z Reyna"
date: "5/12/2021"
output:
flexdashboard::flex_dashboard:
vertical_layout: scroll
orientation: rows
source_code: embed
---
```{r setup, include = FALSE}
library(tidyverse)
library(dplyr)
library(plotly)
library(viridis)
library(highcharter)
library(readxl)
library(rjson)
knitr::opts_chunk$set(fig.width = 5, fig.asp = 1/3)
```
```{r US data import, include = FALSE}
# Format State Column Type
type = cols(`State/Territory/Federal Entity` = col_factor())
# Load Vaccination Data
US_vacc <- read_csv("covid19_vaccinations_in_the_united_states.csv", col_types = type, skip = 2, na = "N/A")
# Clean up column names
names(US_vacc) <- str_to_lower(names(US_vacc)) %>%
str_replace_all(" ","_")
US_vacc <- US_vacc %>% rename_all(.funs = funs(sub("\\_by_state_(where_administered|of_residence)", "", names(US_vacc)))) %>%
rename(state = `state/territory/federal_entity`)
levels(US_vacc$state) <- gsub("New York State","New York", levels(US_vacc$state))
# State Population Data (2019 Census Est.)
state_pop_est <- read_csv("census_pop_totals.csv",
col_types = cols_only("STNAME" = "c",
"CTYNAME" = "c",
"POPESTIMATE2019" = col_double())) %>%
filter(STNAME==CTYNAME) %>%
select(-CTYNAME) %>%
rename(state = STNAME)
state_pop_est <- filter(distinct(state_pop_est, state, .keep_all = TRUE))
names(state_pop_est) <- str_to_lower(names(state_pop_est))
```
```{r tidy bar chat data}
US_vacc_by_pop <- US_vacc %>%
select(state,
`people_18+_fully_vaccinated`,
`people_18+_with_at_least_one_dose`,
`people_65+_fully_vaccinated`,
`people_65+_with_at_least_one_dose`) %>%
inner_join(state_pop_est, by = "state")
US_vacc_by_pop <- US_vacc_by_pop %>%
rename_all(.funs = funs(sub("people_", "", names(US_vacc_by_pop))))
US_vacc_by_pop <- US_vacc_by_pop %>%
pivot_longer(c('18+_fully_vaccinated', '65+_fully_vaccinated'),
names_to = "age_group",
values_to = "fully_vaccinated") %>%
pivot_longer(c('18+_with_at_least_one_dose', '65+_with_at_least_one_dose'),
names_to = "age_group_2",
values_to = "at_least_one_dose") %>%
mutate(age_group = case_when(age_group == "18+_fully_vaccinated" ~ "18+",
age_group == "65+_fully_vaccinated" ~ "65+"),
age_group_2 = case_when(age_group_2 == "18+_with_at_least_one_dose" ~ "18+",
age_group_2 == "65+_with_at_least_one_dose" ~ "65+")) %>%
filter(age_group == age_group_2) %>%
select(-age_group_2) %>%
group_by(age_group) %>%
summarise(total_pop = sum(popestimate2019),
total_fully_vaccinated = sum(fully_vaccinated),
total_at_least_one_dose = sum(at_least_one_dose)) %>%
mutate(total_pop = case_when(age_group == "18+" ~ total_pop*0.78,
age_group == "65+" ~ total_pop*0.17)) %>%
mutate(percent_fully_vaccinated = round((total_fully_vaccinated / total_pop) * 100, 2),
percent_at_least_one_dose = round((total_at_least_one_dose / total_pop) * 100, 2))
```
```{r tidy pie chart data}
# Tidy relevant data
US_manuf <- US_vacc %>%
select(state,
total_number_of_janssen_doses_administered,
total_number_of_moderna_doses_administered,
total_number_of_pfizer_doses_adminstered,
total_number_of_doses_from_unknown_manufacturer_administered) %>%
pivot_longer(c(`total_number_of_janssen_doses_administered`,
`total_number_of_moderna_doses_administered`,
`total_number_of_pfizer_doses_adminstered`,
`total_number_of_doses_from_unknown_manufacturer_administered`),
names_to = "manufacturer", values_to = "doses_administered") %>%
mutate(manufacturer = case_when(manufacturer == "total_number_of_janssen_doses_administered" ~ "Janssen",
manufacturer == "total_number_of_moderna_doses_administered" ~ "Moderna",
manufacturer == "total_number_of_pfizer_doses_adminstered" ~ "Pfizer",
manufacturer == "total_number_of_doses_from_unknown_manufacturer_administered" ~ "Unspecified")) %>%
group_by(manufacturer) %>%
summarise(total_doses = sum(doses_administered))
```
# United States
```{css, echo=FALSE}
.section.sidebar {
top: 61px;
border-bottom: 10px solid #ececec;
border-left: 10px solid #ececec;
background-color: rgba(255, 255, 255, 1);
}}
```
Column {.sidebar data-width=400, data-padding=10}
-------------------------------------
### COVID-19 Vaccination in the US
***
About this Dashboard
The goal of this project is to create a web page using R Markdown that features a plot created with Plotly or a map created with Leaflet. As vaccines become more widely available, many people are turning their attention to vaccination rates in order to assess the nation's response to the ongoing COVID-19 pandemic. With so much vaccination data publicly available, I thought it would be beneficial to combine multiple plot and map elements to recreate a "Vaccine Dashboard" to present a current snapshot of vaccine administration in the US and Texas.
The Data
National-level COVID-19 vaccine data come from the [US Center for Disease Control & Prevention](https://covid.cdc.gov/covid-data-tracker/#vaccinations), with supplemental population data from the [United States Census Bureau](https://www2.census.gov/programs-surveys/popest/datasets/2010-2019/counties/totals/). The CDC compiles data on vaccine deliveries and administration and represents totals from all vaccine partners including jurisdictional partner clinics, retail pharmacies, long-term care facilities, dialysis centers, Federal Emergency Management Agency and Health Resources and Services Administration partner sites, and federal entity facilities. More information for this data can be found [here](https://www.cdc.gov/coronavirus/2019-ncov/vaccines/reporting-vaccinations.html).
Vaccination data for Texas comes from the [Texas Department of State Health Services](https://www.dshs.texas.gov/coronavirus/immunize/vaccine.aspx). More information about this data can be found [here](https://tabexternal.dshs.texas.gov/t/THD/views/COVID-19VaccineinTexasDashboard/AbouttheData?%3Aorigin=card_share_link&%3Aembed=y&%3AisGuestRedirectFromVizportal=y).
***
*Note: Both US-level and Texas state-level data are current as of May 11, 2021.*
Row {data-height=50}
-------------------------------------
### Total Vaccine Doses Adminstered
```{r include = FALSE}
sum(US_vacc$total_doses_administered)
sum(US_vacc$people_fully_vaccinated)
sum(US_vacc$people_with_at_least_one_dose)
```
`r format(round((sum(US_vacc$total_doses_administered))), big.mark = ",")`
### Total Fully Vaccinated
`r format(round((sum(US_vacc$people_fully_vaccinated))), big.mark = ",")`
### Total Vaccinated w/ at Least One Dose
`r format(round((sum(US_vacc$people_with_at_least_one_dose))), big.mark = ",")`
Row {data-height=600}
-------------------------------------
### Percentage of State Population Fully Vaccinated for COVID-19
```{r}
# Create State Vaccination Map
# Source code adapted from "Sales report with highcharter" flexdashboard example at https://pkgs.rstudio.com/flexdashboard/articles/examples.html
thm <-
hc_theme(
colors = c("#1a6ecc", "#434348", "#90ed7d"),
chart = list(
backgroundColor = "transparent"
),
xAxis = list(
gridLineWidth = 1
)
)
data("usgeojson")
n <- 3
colstops <- data.frame(
q = 0:n/n,
c = substring(viridis(n + 1), 0, 7)) %>%
list_parse2()
highchart() %>%
hc_add_series_map(usgeojson, US_vacc, name = "% of Population Fully Vaccinated:",
value = "percent_of_total_pop_fully_vaccinated",
joinBy = c("woename", "state"),
dataLabels = list(enabled = TRUE,
format = '{point.properties.postalcode}')) %>%
hc_colorAxis(stops = colstops, min = 25, max = 45) %>%
hc_legend(valueDecimals = 0, valueSuffix = "%") %>%
hc_mapNavigation(enabled = TRUE) %>%
hc_add_theme(thm)
```
Row
-------------------------------------
### Percent of Population Vaccinated
```{r }
# Create stacked bar chart
age_bar_fig <- plot_ly(US_vacc_by_pop,
x = ~age_group,
y = ~percent_fully_vaccinated,
type = 'bar',
name = 'Fully Vaccinated',
text = ~percent_fully_vaccinated,
hovertemplate = paste('%{x}', '
%{text} %'),
marker = list(color = 'rgb(102,194,165)',
line = list(color = '#000000', width = 1.5)))
age_bar_fig <- age_bar_fig %>%
add_trace(y = ~percent_at_least_one_dose,
name = 'At Least One Dose',
text = ~percent_at_least_one_dose,
hovertemplate = paste('%{x}', '
%{text} %'),
marker = list(color = 'rgb(166,216,84)',
line = list(color = '#000000', width = 1.5)))
age_bar_fig <- age_bar_fig %>%
layout(xaxis = list(title = 'Age Group'),
yaxis = list(title = 'Percent Vaccinated'),
barmode = 'group',
legend = list(x = 0.0, y = 0.9))
age_bar_fig
```
### Total Doses Administered by Manufacturer
``` {r }
# Set color scheme
manuf_colors <- c('rgb(166,206,227)','rgb(31,120,180)', 'rgb(178,223,138)', 'rgb(51,160,44)')
# Create doses administered by manufacturer pie chart
manufac_fig <- US_manuf %>%
plot_ly(labels = ~manufacturer, values = ~total_doses,
textinfo = 'label+percent',
marker = list(colors = manuf_colors,
line = list(color = '#FFFFFF', width = 1)),
showlegend = FALSE)
manufac_fig <- manufac_fig %>% add_pie(hole = 0.5)
manufac_fig <- manufac_fig %>%
layout(showlegend = F,
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
manufac_fig
```
# Texas
```{r}
# Load Texas data column names
tx_col_names <- array(read_excel('tx_vaccine_data_by_county.xlsx', sheet = 2, n_max = 1, col_names = FALSE))
# Import Data (skipping lines 2-4, adding column names from first line)
tx_vacc <- read_xlsx("tx_vaccine_data_by_county.xlsx", sheet = 2, skip = 3)
colnames(tx_vacc) <- tx_col_names
names(tx_vacc) <- str_to_lower(names(tx_vacc)) %>%
str_replace_all(" ","_") %>%
str_replace_all(",", "_")
# Import/Tidy FIPS data
temp = tempfile(fileext = ".xlsx")
data_URL <- "http://www.dshs.state.tx.us/chs/info/TxCoPhrMsa.xls"
download.file(data_URL, destfile=temp, mode='wb')
tx_fips <- read_xlsx(temp) %>%
rename(county_name = `County Name`, fips = `FIPS #`) %>%
mutate(fips = as.numeric(fips),
fips = fips + 48000) %>%
select(county_name, fips)
# Import/Tidy County Population Data (2019 Census Est.)
tx_pop_est <- read_csv("census_pop_totals.csv",
col_types = cols_only("STNAME" = "c",
"CTYNAME" = "c",
"POPESTIMATE2019" = col_double())) %>%
filter(STNAME == "Texas",
STNAME != CTYNAME) %>%
rename(county_name = CTYNAME) %>%
select(-STNAME) %>%
mutate(county_name = str_replace(county_name, "\\s+[^ ]+$", ""))
names(tx_pop_est) <- str_to_lower(names(tx_pop_est))
# Merge FIPS and county pop data with vaccine data
tx_vacc <- tx_vacc %>%
inner_join(tx_fips, by = "county_name") %>%
inner_join(tx_pop_est, by = "county_name")
```
Row {data-height=50}
-------------------------------------
### Total Vaccine Doses Adminstered
```{r include = FALSE}
sum(tx_vacc$vaccine_doses_administered)
sum(tx_vacc$people_fully_vaccinated)
sum(tx_vacc$people_vaccinated_with_at_least_one_dose)
```
`r format(round((sum(tx_vacc$vaccine_doses_administered))), big.mark = ",")`
### Total Fully Vaccinated
`r format(round((sum(tx_vacc$people_fully_vaccinated))), big.mark = ",")`
### Total Vaccinated w/ at Least One Dose
`r format(round((sum(tx_vacc$people_vaccinated_with_at_least_one_dose))), big.mark = ",")`
Row {data-height=450}
-------------------------------------
### Daily Vaccine Doses Administered
```{r}
# Import Data
tx_vacc_daily <- read_excel("tx_vaccine_data_by_county.xlsx", sheet = 4)
names(tx_vacc_daily) <- str_to_lower(names(tx_vacc_daily)) %>%
str_replace_all(" ","_")
tx_vacc_daily <- tx_vacc_daily %>%
mutate(vaccination_date = as.Date(as.numeric(vaccination_date),
origin = "1899-12-30")) %>%
drop_na() %>%
group_by(vaccination_date) %>%
summarise(doses_administered = sum(doses_administered))
# Figure Annotations
phase1a <- tx_vacc_daily %>% filter(vaccination_date == as.Date("2020-12-14"))
phase1b<- tx_vacc_daily %>% filter(vaccination_date == as.Date("2020-12-29"))
phase1c <- tx_vacc_daily %>% filter(vaccination_date == as.Date("2021-03-15"))
open <- tx_vacc_daily %>% filter(vaccination_date == as.Date("2021-03-29"))
uri <- tx_vacc_daily %>% filter(vaccination_date == as.Date("2021-02-13"))
jjpause <- tx_vacc_daily %>% filter(vaccination_date == as.Date("2021-04-13"))
p1a <- list(x = phase1a$vaccination_date,
y = phase1a$doses_administered,
text = "Phase 1a Begins",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 20,
ay = -50)
p1b <- list(x = phase1b$vaccination_date,
y = phase1b$doses_administered,
text = "Phase 1b Begins",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 20,
ay = -50)
p1c <- list(x = phase1c$vaccination_date,
y = phase1c$doses_administered,
text = "Phase 1c Begins",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 0,
ay = -50)
open_ann <- list(x = open$vaccination_date,
y = open$doses_administered,
text = "Open Eligibility",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 15,
ay = -50)
uri_ann <- list(x = uri$vaccination_date,
y = uri$doses_administered,
text = "Winter Storm Uri Hits",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 10,
ay = -50)
jjpause_ann <- list(x = jjpause$vaccination_date,
y = jjpause$doses_administered,
text = "CDC recc. \npausing J&J",
textangle = -75,
xanchor = 'left',
showarrow = TRUE,
arrowhead = 6,
ax = 10,
ay = -50)
#Create Daily Vaccinations Administered Bar Chart
tx_daily_doses_fig <- plot_ly(tx_vacc_daily, x = ~vaccination_date, y = ~doses_administered, type = 'bar', name = 'Doses Administed')
tx_daily_doses_fig <- tx_daily_doses_fig %>%
layout(xaxis = list(title = 'Date',
tickangle = -45),
yaxis = list(title = 'Doses Administered', range = c(0, 400000)),
annotations = p1a) %>%
layout(annotations = p1b) %>%
layout(annotations = p1c) %>%
layout(annotations = open_ann) %>%
layout(annotations = uri_ann) %>%
layout(annotations = jjpause_ann)
tx_daily_doses_fig
```
## Column 2
### State Vaccination Rates
```{r}
# Load geoJSON data
txgeojsondata <- fromJSON(file="https://raw.githubusercontent.com/plotly/datasets/master/geojson-counties-fips.json")
# Mutate data for percent fully vaccinated
tx_vacc <- tx_vacc %>%
mutate(percent_fully_vaccinated = round((people_fully_vaccinated / `population__16+`) * 100, 2))
# Create hover labels
tx_vacc$hover <- with(tx_vacc, paste('% Fully Vaccinated
', county_name, 'County'))
# Created tx plotly map
g <- list(
fitbounds = "locations",
visible = FALSE
)
tx_fig <- plot_ly() %>%
add_trace(type = "choropleth",
geojson = txgeojsondata,
locations = tx_vacc$fips,
z = tx_vacc$percent_fully_vaccinated,
colorscale = "Viridis",
featureidkey = "id",
text = ~tx_vacc$hover) %>%
layout(geo = g) %>%
colorbar(title = "% Vaccinated") %>%
layout(title = "Percent of Population (16+) Fully Vaccinated")
tx_fig
```
### Bexar County, TX Vaccination Hub
```{r}
# hover info
hub_info <- "Alamodome Vaccination Hub
100 Montana St
San Antonio, TX 78203"
# create leaflet map with SATX vaccine hub
library(leaflet)
hub_map <- leaflet() %>%
addTiles() %>%
addMarkers(lat = 29.417160947295688,
lng = -98.4787713866576,
popup = hub_info)
hub_map
```
Row {data-height=75}
-------------------------------------
### Vaccination Hub Info
The city of San Antonio has set up a drive-thru mass vaccination hub at the Alamodome. Though vaccine availability continues to increase, appointments may still be required to receive vaccination. Please visit the city of [San Antonio's COVID-19 Vaccination web page](https://covid19.sanantonio.gov/Services/Vaccination-for-COVID-19) for more information on registering for an appointment.