TidyTuesday Measles Vaccination - 2020-WK9

Pull in the data

First we’ll pull in the data and create some quick summary tables which can be found at the bottom of this post for reference.

# LOAD DATA
#--------------------------------------------------------
dt_yr <- year(Sys.Date())
dt_wk_no <- week(Sys.Date())

# Read in data which takes the year and week number
d_in <- tidytuesdayR::tt_load(dt_yr, dt_wk_no)%>%.$measles

# Without setting the data as a variable, a viewer panel will bring up the site details
# This includes a data dictionary and source of data
tidytuesdayR::tt_load(dt_yr, dt_wk_no)

# INSPECT DATA
#------------------------------------------------------------

t1 <- map_df(d_in, ~length(unique(.)))%>%
  gather(variable, value)%>%
  kable(., caption = "Unique Values", format.args = list(big.mark = ","), format = "html")

t2 <- map_df(d_in, ~sum(is.na(.)))%>%
  gather(variable, value)%>%
  kable(., caption = "Number of NA's", format.args = list(big.mark = ","), format = "html")

t3 <- d_in%>%
  select_if(is.numeric)%>%
  map_df(., ~range(., na.rm=T))%>%
  gather(variable, value)%>%
  group_by(variable)%>%
  mutate(row_id = row_number())%>%
  ungroup()%>%
  mutate(variable_cat = ifelse(row_id==1, paste0(variable, "_lo"), paste0(variable, "_hi")))%>%
  select(-c(row_id, variable))%>%
  select(variable_cat, value)%>%
  kable(., caption = "Range of Numerics", format = "html")

Our plot

Since there are quite a few gaps within the dataset, we will focus on attempting to build a map of median vaccination percent by Washington state school district. Note that we are note keeping a tally, but for clarity – the lower of the overall vaccination should be interpreted as higher potential risk and higher values on the y-axis as an indication of a higher percent of students receiving common vaccinations.

Our geometry layers will be:

1. State outline for WA (U.S. Census)

2. Add borders for individual school districts (U.S. Census)

3. Map points of individual schools reported in the TidyTuesday dataset

3.1. Facet the plot based on the overall reported vaccination proportion in the dataset

# Create a base theme for our map 
theme_map_sq <- function(...){
  theme_minimal()+
    theme(
      title = element_text(family = "Arial", color = "white"),
      axis.line = element_blank(),
      axis.text.x = element_blank(),
      axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      axis.title.x = element_blank(),
      axis.title.y = element_blank(),
      # panel.grid.minor = element_line(color = "#ebebe5", size = 0.2),
      panel.grid.major = element_blank(),
      panel.grid.minor = element_blank(),
      plot.background = element_rect(fill = "#000000", color = NA), 
      panel.background = element_rect(fill = "#000000", color = NA), 
      panel.border = element_blank(),
      ...
    )
}

# Create breaks for our facet based on observations from our data
cln_brks <- c(0, 30, 65, 75, 80, 85, 90, 95, 100)

# Create our median aggregation of overall vaccination levels
# We also do some text cleaning of our breaks for better facet labels

d_agg <- dc_geo_wa%>%
  select(index, st_name = state, school_name = name, fips2 = STATEFP, 
        cens_geoid = GEOID, cens_dist_name = NAME, city, county, 
        enroll, overall, xrel, xmed, xper, geometry)%>%
  group_by(cens_dist_name)%>%
  summarize(median_overall = median(overall, na.rm = T))%>%
  ungroup()%>%
  mutate(geometry = st_cast(geometry, "POINT"), 
         brk_facet = cut(median_overall, breaks = cln_brks),
         brk_facet = str_replace_all(brk_facet, pattern = "\\(|\\]", ""), 
         brk_facet = str_replace_all(brk_facet, pattern = "\\,", " to "))%>%
  na.omit()



p2 <- ggplot()+
  geom_sf(data = d_wa, fill = "#000000", color = "white", alpha = 0.85)+
  geom_sf(data = d_wa_school, fill = "#000000", color = "white", alpha = .85)+
  geom_sf(data = d_agg, aes(geometry = st_jitter(geometry, factor = 0.01)),
          size = 2, color = "darkred", fill = "darkred")+
  labs(title = "Overall vaccination rates by school district",
       subtitle = "United States, Washington State (2018-2019)",
       caption = "Date: TidyTuesday, 2020, Wk = 9",
       x = NULL, 
       y = NULL)+
  facet_wrap(~brk_facet)+
  theme_map_sq()+
  theme(legend.position = "none", 
        strip.background = element_rect(fill = "white"), 
        strip.text = element_text(face = "bold"))



p2

Reference: Data Inspection Tables

# Length of distinct variables
t1

# Number of NAs by variable
t2

# Range of integer variables

t3