R code for US State level Vaccination Rates

# Packages --------------------------

library(tidyverse)
library(lubridate)
library(highcharter)
library(htmlwidgets)
library(directlabels)
library(ggrepel)

theme_custom <- function () { 
  theme(axis.text.x = element_text(colour="white"),
        axis.text.y = element_text(colour="white"),
        axis.ticks.x = element_blank(),
        axis.ticks.y = element_blank(),
        panel.background = element_rect(fill = "#202124"),
        panel.grid = element_blank(),
        plot.subtitle = element_text(color = "white"),
        plot.background = element_rect(fill = "#202124"))}

# Import --------------------------

url <- "https://github.com/COVID19Tracking/covid-tracking-data/raw/master/data/cdc_vaccinations_timeseries_daily.csv"

df <- read_csv(url)

# ggplot --------------------------

df %>% 
  select(Date, Location, LongName, Administered_Dose1_Pop_Pct) %>% 
  mutate(key_loc = case_when(LongName %in% c("New Mexico", 
                                             "Puerto Rico", 
                                             "United States") ~ "key",
                                             TRUE ~ "other"))  %>% 
  mutate(label = if_else(Date == max(Date) & 
                           LongName %in% c("New Mexico", 
                                           "Puerto Rico", 
                                           "United States"), LongName, NA_character_)) %>% 
  filter(!Location %in% c("BP2","FM", "DD2", "AS", "GU", "IH2", "MH", "MP", "RP", "VI", "LTC", "VA2")) %>% 
  filter(Date > "2021-02-01") %>% 
  ggplot(aes(Date, Administered_Dose1_Pop_Pct, group = LongName, color = key_loc)) +
  scale_color_manual(values = c("#F72485", "grey30")) +
  scale_x_date(breaks = scales::pretty_breaks(8)) +
  geom_line() +
  geom_dl(aes(label = label), method = list(dl.combine("last.points"))) +
  theme(legend.position = "none") +
  expand_limits(x = as.Date(c(NA, "2021-04-15"))) +
  labs(x = "", y = "",
       subtitle = "\nPercent of Population having received a first dose.\n") +
  theme_custom()

ggsave("vaccts.png", width = 10, height = 6)

# highchart --------------------------

df_mar1 <- df %>% 
  filter(Date == "2021-03-01") %>% 
  select(Location, Administered_Dose1_Pop_Pct)

hc <- hcmap(
  "https://code.highcharts.com/mapdata/countries/us/us-all.js",
  data = df_mar1,
  value = "Administered_Dose1_Pop_Pct",
  joinBy = c("hc-a2", "Location"),
  name = "Percent of Pop recieving Vaccine Dose 1",
  #dataLabels = list(enabled = TRUE, format = "{point.name}"),
  borderColor = "#202124",
  borderWidth = 0.5,
  tooltip = list(
    valueDecimals = 1,
    valuePrefix = "",
    valueSuffix = "%")) %>% 
  hc_mapNavigation(enabled = TRUE) %>% 
  hc_colorAxis(minColor = "#ff67b4", maxColor = "#be0059") %>% 
  hc_add_theme(hc_theme(
    chart = list(
      backgroundColor = "#202124")))

saveWidget(hc, file="highchart.html")
Edit
Pub: 02 Apr 2021 03:41 UTC
Views: 352