Limitations

These data have the following limitations (to name a few):

• These data represent the distribution of data in time and space, not a causal relationship between any of the measures of interest.
• States have incomplete data about the number of people with COVID-19 infections and deaths, especially when stratified race and ethnicity. This is even more relevant when examing data from early in the pandemic.
• To call testing uptake slow and variable across states would be an understatement, so earlier dates may reflect heterogeneity in testing uptake instead of heterogeneity in COVID-19 infections and/or deaths.
• It is not clear that every state collects race and ethnicity data in the same way, for example, some states may use self-report whereas others may rely on race and ethnicity determinations made by health care professionals.
• The COVID Tracking Project and the US Census Bureau used different categories for race and ethnicity.
• Many states report COVID-19 infections/deaths in people of unknown race/ethnicity. I have included these data as part of the denominator (total infections/deaths) in my calculations, even though a portion (perhaps even a majority) of these infections/deaths have actually occured in Black or Latinx individuals, so my difference and ratio estimates are underestimates.
• COVID-19 infections and deaths in the US have all occurred in 2020, whereas my denominator (number of people living in each state) uses the most recent data available, projections from 2019. Furthermore, the Area Deprivation Index data are from 2015.
• As time progresses on each plot, the legend changes to accommodate the most recent data. This can make values that were relatively high appear lower despite remaining constant because, for example, The COVID Tracking Project started tracking data from a new state on that date with higher values.
• The Area Deprivation Index represents relative percentiles for each People. To make it comparable with state-level measures of COVID-19 infections and deaths, I took the median of all ADI levels within each state, which obscures the intra-state heterogeneity visible at the Census Block Group level.
• Previous iterations of this document dichotomized people to White and Non-White in the primary analyses for convenience, and due to concerns about sparse data in more specific categories, which assumes that I categorized White and Non-White correctly from the slightly different definitions from The COVID Tracking Project and the US Census Bureau. However, on further investigation, the differences in data collection were so heterogenous across states that I do not feel those numbers are comparable. This is, in part, due to differences in how different states report infections/deaths among Latinx individuals. Some states report them as Latinx and include them as a race and others report them as Hispanic and report them as an ethinicity. Including them would therefore inflate the Non-White infections/deaths numerator in some states, making the measurements unreliable.

Disclaimers

Although I occasionally stray into interpretations when providing context, the primary purpose of this report is to present the data. I do not attempt to create models, make predictions, or give advice. If you have questions, suggestions, or notice an error (there are likely a few), please reach out (danny_sack)!

Any views and opinions expressed here strickly represent those of the author and are not necessarily those of Vanderbilt University Medical Center, the Vanderbilt Medical Scientist Training Program, or the Division of Epidemiology.

Disclaimer from The COVID Tracking Project: “Our data will always be an undercount. We can only track tests that states report, and not all states report all tests. More significantly, per-capita testing levels in the US remain low, which means that an unknown but probably very large number of people are sick, but aren’t being tested. But this is the data we can collect, and it provides the most detailed information available about the shape and relative severity of outbreaks in US states and territories.”

Disclaimer from the Area Deprivation Index website: “The ADI is limited insofar as it uses American Community Survey (ACS) Five Year Estimates in its construction. For example, the 2015 ADI uses the ACS data for 2015, which is a 5-year average of ACS data obtained from 2011-2015. All limitations of the source data will persist throughout the ADI. The choice of geographic units will also influence the ADI value. In the case of the ADI the Census Block Group is the geographic unit of construction, as the Census Block Group is considered the closest approximation to a”neighborhood“. All results are subject to the accuracy and errors contained within the American Community Survey data release.”

Resources

While many excellent resources exist with more information on and strategies to address health inequities and the structures that underlie them (such as racism), the following are a good a place to start:

• JAMA viewpoint entitled COVID-19 and Health Equity—A New Kind of “Herd Immunity” (Williams & Cooper, 2020)
• Dr. Uché Blackstock’s organization, Advancing Health Equity
• Tennessean opinion piece entitled, COVID-19 amplifies social inequalities that have driven racial health disparities for decades (Furuyama, Kaur, Lee, Limb, 2020)
• NEJM perspective: Stolen Breaths (Hardeman, Medina, Boyd, 2020)
• JAMA viewpoint on Responding to the COVID-19 Pandemic: The Need for a Structurally Competent Health Care System (Metzl, Maybank, De Maio, 2020)
• Annals of Internal Medicine article on Historical Insights on Coronavirus Disease 2019 (COVID-19), the 1918 Influenza Pandemic, and Racial Disparities: Illuminating a Path Forward (Krishnan, Ogunwole, Cooper, 2020)
• The American Association for Public Health’s Health Equity Page
• The Conversation article on recognizing the social justice aspects of health (Julian, Hardeman, Huerto, 2020)
• The Vanderbilt University Medical Center Office of Health Equity, including their Anti-Racism Resources

# pull data from https://covidtracking.com/race/dashboard
df <- read.csv("https://docs.google.com/spreadsheets/d/e/2PACX-1vS8SzaERcKJOD_EzrtCDK1dX1zkoMochlA9iHoHg_RSw3V8bkpfk1mpw4pfL5RdtSOyx_oScsUtyXyk/pub?gid=43720681&single=true&output=csv")

names(df)[1] <- "day"
names(df)[2] <- "state"

df$day <- as.Date(as.character(df$day), "%Y%m%d")

# get rid of random NAs at the bottom
df <- subset(df, !is.na(day))

# just infections
infxn <- df[, c(1:15)]

# clean up columns
inf <- data.frame(day = infxn$day, 
                  date = NA,
                  state = infxn$state,
                  tot_inf = infxn$Cases_Total, 
                  inf_white = infxn$Cases_White,
                  inf_black = infxn$Cases_Black,
                  inf_hisp = NA,
                  inf_asian = infxn$Cases_Asian,
                  inf_aian = infxn$Cases_AIAN,
                  inf_nhpi = infxn$Cases_NHPI,
                  inf_mulra = infxn$Cases_Multiracial,
                  inf_other = infxn$Cases_Other,
                  inf_unk = infxn$Cases_Unknown)
# hispanic, take min of two measurements
for(i in 1:length(inf$inf_hisp)){
  inf$inf_hisp[i] <- min(as.numeric(infxn$Cases_LatinX[i]), 
                     as.numeric(infxn$Cases_Ethnicity_Hispanic[i]), na.rm = TRUE)
  if(is.infinite(inf$inf_hisp[i])) {inf$inf_hisp[i] <- NA}
}

# order dates, don't really know why this works...
inf$date <- factor(inf$day, levels = format(sort(unique(as.Date(inf$day))), "%b %d, %Y"))
for(i in 1:nrow(inf)){
  inf$date[i] <- format(inf$day[i], "%b %d, %Y")
}

# label columns
label(inf$day) <- "Day"
label(inf$date) <- "Date"
label(inf$state) <- "State"

# now make numeric
for(i in c("tot_inf", "inf_white", "inf_black", "inf_hisp", "inf_asian", "inf_aian", 
           "inf_nhpi", "inf_mulra", "inf_other", "inf_unk")) {
  inf[, c(i)] <- as.numeric(inf[, c(i)])
}

label(inf$tot_inf) <- "Total Infections"
label(inf$inf_white) <- "Reported Infections in White People"
label(inf$inf_black) <- "Reported Infections in Black People"
label(inf$inf_hisp) <- "Reported Infections in Latinx People"
label(inf$inf_asian) <- "Reported Infections in Asian People"
label(inf$inf_aian) <- "Reported Infections in AIAN People"
label(inf$inf_nhpi) <- "Reported Infections in NHPI People"
label(inf$inf_mulra) <- "Reported Infections in Multiracial People"
label(inf$inf_other) <- "Reported Infections in People on Another Race"
label(inf$inf_unk) <- "Reported Infections in People with an Unknown Race"

# do the same thing for deaths
# just deaths
deaths <- df[, c(1:2, 16:26)]

# names
names(deaths) <- c("day", "state", "tot_d", "d_white", "d_black", "d_hisp",
                   "d_asian", "d_aian", "d_nhpi", "d_mulra", "d_other", "d_unk",
                   "d_hisp1")

# order dates, don't really know why this works...
deaths$date <- factor(deaths$day, levels = format(sort(unique(as.Date(deaths$day))), "%b %d, %Y"))
for(i in 1:nrow(deaths)){
  deaths$date[i] <- format(deaths$day[i], "%b %d, %Y")
}

# label columns
label(deaths$day) <- "Day"
label(deaths$date) <- "Date"
label(deaths$state) <- "State"

# now make numeric
for(i in c("tot_d", "d_white", "d_black", "d_hisp", "d_asian", 
           "d_aian", "d_nhpi", "d_mulra", "d_other", "d_unk",
                   "d_hisp1")) {
  deaths[, c(i)] <- as.numeric(deaths[, c(i)])
}
# hispanic, take min of two measurements
for(i in 1:length(deaths$d_hisp)){
  deaths$d_hisp[i] <- min(deaths$d_hisp[i], deaths$d_hisp1[i], na.rm = TRUE)
  if(is.infinite(deaths$d_hisp[i])) {deaths$d_hisp[i] <- NA}
}

deaths$d_hisp1 <- NULL

label(deaths$tot_d) <- "Total Deaths"
label(deaths$d_white) <- "Reported Deaths in White People"
label(deaths$d_black) <- "Reported Deaths in Black People"
label(deaths$d_hisp) <- "Reported Deaths in Latinx People"
label(deaths$d_asian) <- "Reported Deaths in Asian People"
label(deaths$d_aian) <- "Reported Deaths in AIAN People"
label(deaths$d_nhpi) <- "Reported Deaths in NHPI People"
label(deaths$d_mulra) <- "Reported Deaths in Multiracial People"
label(deaths$d_other) <- "Reported Deaths in People on Another Race"
label(deaths$d_unk) <- "Reported Deaths in People with an Unknown Race"

# merge inf and death
data <- merge(inf, deaths, by = c("day", "date", "state"))

# https://www.census.gov/data/tables/time-series/demo/popest/2010s-counties-detail.html
# Annual County Resident Population Estimates by Age, Sex, Race, and Hispanic Origin: April 1, 2010 to July 1, 2019 (CC-EST2019-ALLDATA), only for 2019, which is 12, the 7/1/2019 population estimate, and make some new categories
# Sex, Race, and Hispanic Origin
# Annual Estimates of the Resident Population by Sex, Race, and Hispanic Origin

all19 <- read_csv("https://www2.census.gov/programs-surveys/popest/datasets/2010-2019/counties/asrh/cc-est2019-alldata.csv") %>% filter(YEAR == 12, AGEGRP == 0) %>%
  mutate(NHWA = NHWA_MALE + NHWA_FEMALE, # non hispanic whites
         NHBA = NHBA_MALE + NHBA_FEMALE, # non hispanic blacks
         NHAA = NHAA_MALE + NHAA_FEMALE, # non hispanic asians
         NHIA = NHIA_MALE + NHIA_FEMALE, # non hispanic american indian
         NHNA = NHNA_MALE + NHNA_FEMALE, # non hispanic native hawaiian
         NHTOM = NHTOM_MALE + NHTOM_FEMALE, # non hispanic two or more
         H = H_MALE + H_FEMALE # hispanic
         ) 

# condense by couties
pop19 <- all19 %>%
  dplyr::group_by(STATE, STNAME) %>% # get rid of age categories
  summarise(TOT_POP = sum(TOT_POP),
            NHWA = sum(NHWA), # non hispanic whites
            NHBA = sum(NHBA), # non hispanic blacks
            NHAA = sum(NHAA), # non hispanic asians
            NHIA = sum(NHIA), # non hispanic american indian
            NHNA = sum(NHNA), # non hispanic native hawaiian
            NHTOM = sum(NHTOM), # non hispanic two or more
            H = sum(H)) %>% # hispanic
  mutate(NH = sum(NHWA, NHBA, NHAA, NHIA, NHNA, NHTOM),
         prop_w = NHWA / TOT_POP,
         prop_b = NHBA / TOT_POP,
         prop_a = NHAA / TOT_POP,
         prop_o = sum(NHIA, NHNA, NHTOM) / TOT_POP,
         prop_h = H / TOT_POP,
         prop_nw = sum(NHBA, NHAA, NHIA, NHNA, NHTOM, H) / TOT_POP,
         prop_nh = NH / TOT_POP)

# make a new dataset to merge
pop <- data.frame(state = state2abbr(pop19$STNAME),
                  tot_pop = pop19$TOT_POP,
                  tot_white = pop19$NHWA,
                  tot_black = pop19$NHBA,
                  tot_hisp = pop19$H,
                  tot_asian = pop19$NHAA,
                  tot_aian = pop19$NHIA,
                  tot_nhpi = pop19$NHNA,
                  tot_mulra = pop19$NHTOM)

# shape file of US states
# https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html
# https://www2.census.gov/geo/tiger/GENZ2018/shp/cb_2018_us_state_500k.zip

# read in shapefile
states <- st_read("cb_2018_us_state_500k/cb_2018_us_state_500k.shp")

# read in adi file
# from https://www.neighborhoodatlas.medicine.wisc.edu
adi <- read.table("adi/US_blockgroup_15.txt", header = TRUE, sep = ",")

# states with geo codes less than 10 only have 11 digits
adi$state <- ifelse(nchar(adi$fips) == 11, substr(adi$fips, 1, 1), substr(adi$fips, 1, 2))

# make adi numeric
adi$adi_natrank <- as.numeric(adi$adi_natrank)

# add adi to state name

states$adi <- NA
# median adi per state
for(i in 1:length(states$adi)){
  # median
  states$adi[i] <- median(adi$adi_natrank[adi$state == as.numeric(states$GEOID[i])], na.rm = TRUE)
  if(is.nan(states$adi[i])) {states$adi[i] <- NA}
}

# merge these population data with "data"

# remove rows with states not in pop (american samoa, guam, etc.)
for(i in 1:nrow(data)){
  if(data$state[i] %nin% pop$state) {
    data <- data[-c(i), ]
  }
}

# initialize columns
data$tot_pop <- data$tot_white <- data$tot_black <- 
  data$tot_hisp <- data$tot_asian <- data$tot_aian <- 
  data$tot_nhpi <- data$tot_mulra <- NA

for(i in 1:nrow(data)) {
  data$tot_pop[i] <- pop[pop$state == data$state[i], "tot_pop"]
  data$tot_white[i] <- pop[pop$state == data$state[i], "tot_white"]
  data$tot_black[i] <- pop[pop$state == data$state[i], "tot_black"]
  data$tot_hisp[i] <- pop[pop$state == data$state[i], "tot_hisp"]
  data$tot_asian[i] <- pop[pop$state == data$state[i], "tot_asian"]
  data$tot_aian[i] <- pop[pop$state == data$state[i], "tot_aian"]
  data$tot_nhpi[i] <- pop[pop$state == data$state[i], "tot_nhpi"]
  data$tot_mulra[i] <- pop[pop$state == data$state[i], "tot_mulra"]
}

# label columns
label(data$tot_pop) <- "2019 Estimated Total Population"
label(data$tot_white) <- "2019 Estimated White Population"
label(data$tot_black) <- "2019 Estimated Black Population"
label(data$tot_hisp) <- "2019 Estimated Hispanic Population"
label(data$tot_asian) <- "2019 Estimated Asian Population"
label(data$tot_aian) <- "2019 Estimated AIAN Population"
label(data$tot_nhpi) <- "2019 Estimated NHPI Population"
label(data$tot_mulra) <- "2019 Estimated Multiracial Population"

# proportion non-white in each state
for(i in 1:nrow(data)){
  data$prop_nw_pop[i] <- sum(data[i, c("tot_black", "tot_hisp", "tot_asian",
                                 "tot_aian", "tot_nhpi", "tot_mulra")]) / data$tot_pop[i]
}
label(data$prop_nw_pop) <- "2019 Estimated Proportion of Non-White Population"

# create column in data dataframe with proportion of infections and deaths in nonwhite, 
# white, black, and latinx people
for(i in 1:nrow(data)){
  # total infections
  # non-white folks
  data$non_white_inf[i] <- sum(data[i, c("inf_black", "inf_asian",
                                    "inf_nhpi", "inf_aian", "inf_mulra", "inf_other")], na.rm = TRUE)
  data$prop_nw_inf[i] <- sum(as.numeric(data[i, c("inf_black", "inf_asian",
                                              "inf_nhpi", "inf_aian", "inf_mulra", "inf_other")]), 
                             na.rm = TRUE) / sum(data[i, c("tot_inf")], na.rm = TRUE)
  # white, black, and latinx folks if more than 25 infections per group
  # white
  if(data$inf_white[i] > 0 & !is.na(data$inf_white[i])) {data$prop_w_inf[i] <- data$inf_white[i] / data$tot_inf[i]}
  else{data$prop_w_inf[i] <- NA}
  # black
  if(data$inf_black[i] > 0 & !is.na(data$inf_black[i])) {data$prop_b_inf[i] <- data$inf_black[i] / data$tot_inf[i]}
  else{data$prop_b_inf[i] <- NA}
  # latinx
  if(data$inf_hisp[i] > 0 & !is.na(data$inf_hisp[i])) {data$prop_l_inf[i] <- data$inf_hisp[i] / data$tot_inf[i]}
  else{data$prop_l_inf[i] <- NA}
  # total deaths in non-white folks
  data$non_white_d[i] <- sum(data[i, c("d_black", "d_asian",
                                    "d_nhpi", "d_aian", "d_mulra", "d_other")], na.rm = TRUE)
  data$prop_nw_d[i] <- sum(as.numeric(data[i, c("d_black", "d_asian",
                                              "d_nhpi", "d_aian", "d_mulra", "d_other")]), 
                        na.rm = TRUE) / sum(data[i, c("tot_d")], na.rm = TRUE)
  # white, black, and latinx folks if more than 25 deaths per group
  # white
  if(data$d_white[i] > 0 & !is.na(data$d_white[i])) {data$prop_w_d[i] <- data$d_white[i] / data$tot_d[i]}
  else{data$prop_w_d[i] <- NA}
  # black
  if(data$d_black[i] > 0 & !is.na(data$d_black[i])) {data$prop_b_d[i] <- data$d_black[i] / data$tot_d[i]}
  else{data$prop_b_d[i] <- NA}
  # latinx
  if(data$d_hisp[i] > 0 & !is.na(data$d_hisp[i])) {data$prop_l_d[i] <- data$d_hisp[i] / data$tot_d[i]}
  else{data$prop_l_d[i] <- NA}
}
label(data$non_white_inf) <- "Reported Infections in Non-White People"
label(data$prop_nw_inf) <- "Proportion of Infections in Non-White People"
label(data$non_white_d) <- "Reported Deaths in Non-White People"
label(data$prop_nw_d) <- "Proportion of Deaths in Non-White People"
label(data$prop_w_inf) <- "Proportion of Infections in White People"
label(data$prop_w_d) <- "Proportion of Deaths in White People"
label(data$prop_b_inf) <- "Proportion of Infections in Black People"
label(data$prop_b_d) <- "Proportion of Deaths in Black People"
label(data$prop_l_inf) <- "Proportion of Infections in Latinx People"
label(data$prop_l_d) <- "Proportion of Deaths in Latinx People"

# get rid of infinte and non-numeric values created by missing data (and inadvertent zeros)
for(i in 1:nrow(data)){
  # infections
  if(is.infinite(data$non_white_inf[i]) | is.nan(data$non_white_inf[i]) | data$non_white_inf[i] == 0) {
    data$non_white_inf[i] <- NA
  }
  if(is.infinite(data$prop_nw_inf[i]) | is.nan(data$prop_nw_inf[i]) | data$prop_nw_inf[i] == 0) {
    data$prop_nw_inf[i] <- NA
  }
  # deaths
  if(is.infinite(data$non_white_d[i]) | is.nan(data$non_white_d[i]) | data$non_white_d[i] == 0) {
    data$non_white_d[i] <- NA
  }
  if(is.infinite(data$prop_nw_d[i]) | is.nan(data$prop_nw_d[i]) | data$prop_nw_d[i] == 0) {
    data$prop_nw_d[i] <- NA
  }
}

# now calculate the proportion of infections/deaths in non-white versus the population proportion of non-whites
# infections
# non-white
data$inf_ratio_nw <- data$prop_nw_inf / data$prop_nw_pop
label(data$inf_ratio_nw) <- "Ratio of Non-White Infection Proportion<br>to Non-White Population Proportion"
# whites
data$inf_ratio_w <- data$prop_w_inf / (data$tot_white / data$tot_pop)
label(data$inf_ratio_w) <- "Ratio of Non-White Infection Proportion<br>to White Population Proportion"
# blacks
data$inf_ratio_b <- data$prop_b_inf / (data$tot_black / data$tot_pop)
label(data$inf_ratio_b) <- "Ratio of Non-White Infection Proportion<br>to Black Population Proportion"
# latinx
data$inf_ratio_l <- data$prop_l_inf / (data$tot_hisp / data$tot_pop)
label(data$inf_ratio_l) <- "Ratio of Non-White Infection Proportion<br>to Latinx Population Proportion"
# deaths
# non-whites
data$d_ratio_nw <- data$prop_nw_d / data$prop_nw_pop
label(data$d_ratio_nw) <- "Ratio of Non-White Death Proportion<br>to Non-White Population Proportion"
# whites
data$d_ratio_w <- data$prop_w_d / (data$tot_white / data$tot_pop)
label(data$d_ratio_w) <- "Ratio of Non-White Death Proportion<br>to White Population Proportion"
# blacks
data$d_ratio_b <- data$prop_b_d / (data$tot_black / data$tot_pop)
label(data$d_ratio_b) <- "Ratio of Non-White Death Proportion<br>to Black Population Proportion"
# latinx
data$d_ratio_l <- data$prop_l_d / (data$tot_hisp / data$tot_pop)
label(data$d_ratio_l) <- "Ratio of Non-White Infection Proportion<br>to Latinx Population Proportion"

# get rid of places that are not reporting infection by race
for(i in 1:length(data$inf_ratio_nw)){
  # infections
  if(data$inf_ratio_nw[i] == 0 & !is.na(data$inf_ratio_nw[i])) {
    data$inf_ratio_nw[i] <- NA
  }
  # deaths
  if(data$d_ratio_nw[i] == 0 & !is.na(data$d_ratio_nw[i])) {
    data$d_ratio_nw[i] <- NA
  }
}

# calculate differences in proportions
# infections
# non-whites
data$inf_diff_nw <- data$prop_nw_inf - data$prop_nw_pop
label(data$inf_diff_nw) <- "Difference between Non-White Infection Proportion<br>and Non-White Population Proportion"
# whites
data$inf_diff_w <- data$prop_w_inf - (data$tot_white / data$tot_pop)
label(data$inf_diff_w) <- "Difference of Non-White Infection Proportion<br>to White Population Proportion"
# blacks
data$inf_diff_b <- data$prop_b_inf - (data$tot_black / data$tot_pop)
label(data$inf_diff_b) <- "Difference of Non-White Infection Proportion<br>to Black Population Proportion"
# latinx
data$inf_diff_l <- data$prop_l_inf - (data$tot_hisp / data$tot_pop)
label(data$inf_diff_l) <- "Ratio of Non-White Infection Proportion<br>to Latinx Population Proportion"
# deaths
# non-whites
data$d_diff_nw <- data$prop_nw_d - data$prop_nw_pop
label(data$d_diff_nw) <- "Difference between Non-White Infection Proportion<br>and Non-White Population Proportion"
# whites
data$d_diff_w <- data$prop_w_d - (data$tot_white / data$tot_pop)
label(data$d_diff_w) <- "Difference of Non-White Death Proportion<br>to White Population Proportion"
# blacks
data$d_diff_b <- data$prop_b_d - (data$tot_black / data$tot_pop)
label(data$d_diff_b) <- "Difference of Non-White Death Proportion<br>to Black Population Proportion"
# latinx
data$d_diff_l <- data$prop_l_d - (data$tot_hisp / data$tot_pop)
label(data$d_diff_l) <- "Difference of Non-White Infection Proportion<br>to Latinx Population Proportion"

# get rid of places that are not reporting infection by race
for(i in 1:length(data$inf_diff_nw)){
  # infections
  if(is.na(data$prop_nw_inf[i])) {
    data$inf_diff_nw[i] <- NA
  }
  # deaths
  if(is.na(data$prop_nw_d[i])) {
    data$d_diff_nw[i] <- NA
  }
}

# calculate infections/deaths per 100000 people in each state
# infections
data$infpp <- (data$tot_inf / data$tot_pop) * 100000
label(data$infpp) <- "Infections per 100,000"
# infections
data$dpp <- (data$tot_d / data$tot_pop) * 100000
label(data$dpp) <- "Infections per 100,000"

# remove territories from states dataframe
states <- states[states$STUSPS %in% data$state, ]

# now add in adi to data
data$adi <- NA
for(i in 1:nrow(data)){
  for(j in 1:nrow(states)){
    if(data$state[i] == states$STUSPS[j]){
      data$adi[i] <- states$adi[j]
    }
  }
}
label(data$adi) <- "Area Deprivation Index, 2015"

# get most recent date deaths an infection dataframes
data_rec <- subset(data, day == max(unique(day)))

# add in infections and death ratio and difference and raw numbers and proportions
states$inf_tot <- NA
states$death_tot <- NA
states$inf_nw <- NA
states$deaths_nw <- NA
states$inf_w <- NA
states$deaths_w <- NA
states$inf_b <- NA
states$deaths_b <- NA
states$inf_l <- NA
states$deaths_l <- NA
states$inf_prop_nw <- NA
states$deaths_prop_nw <- NA
states$inf_prop_w <- NA
states$deaths_prop_w <- NA
states$inf_prop_b <- NA
states$deaths_prop_b <- NA
states$inf_prop_l <- NA
states$deaths_prop_l <- NA
states$inf_ratio_nw <- NA
states$death_ratio_nw <- NA
states$inf_diff_nw <- NA
states$death_diff_nw <- NA
states$inf_ratio_w <- NA
states$death_ratio_w <- NA
states$inf_diff_w <- NA
states$death_diff_w <- NA
states$inf_ratio_b <- NA
states$death_ratio_b <- NA
states$inf_diff_b <- NA
states$death_diff_b <- NA
states$inf_ratio_l <- NA
states$death_ratio_l <- NA
states$inf_diff_l <- NA
states$death_diff_l <- NA
for(i in 1:length(states$death_ratio_nw)){
  # raw numbers
  states$inf_tot[i] <- data_rec[data_rec$state == states$STUSPS[i], "tot_inf"]
  states$death_tot[i] <- data_rec[data_rec$state == states$STUSPS[i], "tot_d"]
  states$inf_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "non_white_inf"]
  states$death_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "non_white_d"]
  states$inf_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_white"]
  states$deaths_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_white"]
  states$inf_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_black"]
  states$deaths_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_black"]
  states$inf_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_hisp"]
  states$deaths_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_hisp"]
  states$inf_prop_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_nw_inf"]
  states$deaths_prop_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_nw_d"]
  states$inf_prop_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_w_inf"]
  states$deaths_prop_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_w_d"]
  states$inf_prop_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_b_inf"]
  states$deaths_prop_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_b_d"]
  states$inf_prop_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_l_inf"]
  states$deaths_prop_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_l_d"]
  # ratio
  states$inf_ratio_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_ratio_nw"]
  states$death_ratio_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_ratio_nw"]
  states$inf_ratio_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_ratio_w"]
  states$death_ratio_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_ratio_w"]
  states$inf_ratio_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_ratio_b"]
  states$death_ratio_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_ratio_b"]
  states$inf_ratio_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_ratio_l"]
  states$death_ratio_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_ratio_l"]
  # difference
  states$inf_diff_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_diff_nw"]
  states$death_diff_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_diff_nw"]
  states$inf_diff_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_diff_w"]
  states$death_diff_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_diff_w"]
  states$inf_diff_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_diff_b"]
  states$death_diff_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_diff_b"]
  states$inf_diff_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "inf_diff_l"]
  states$death_diff_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "d_diff_l"]
}

# add proportion of non-white people in each state
states$prop_nw <- NA
states$prop_w <- NA
states$prop_b <- NA
states$prop_l <- NA
for(i in 1:length(states$prop_nw)){
  states$prop_nw[i] <- data_rec[data_rec$state == states$STUSPS[i], "prop_nw_pop"]
  states$prop_w[i] <- data_rec[data_rec$state == states$STUSPS[i], "tot_white"] / 
    data_rec[data_rec$state == states$STUSPS[i], "tot_pop"]
  states$prop_b[i] <- data_rec[data_rec$state == states$STUSPS[i], "tot_black"] / 
    data_rec[data_rec$state == states$STUSPS[i], "tot_pop"]
  states$prop_l[i] <- data_rec[data_rec$state == states$STUSPS[i], "tot_hisp"] / 
    data_rec[data_rec$state == states$STUSPS[i], "tot_pop"]
}

# set up for ploting
# give state boundaries a white border
l <- list(color = toRGB("white"), width = 2)
# specify some map projection/options
g <- list(
  scope = 'usa',
  projection = list(type = 'albers usa'),
  showlakes = TRUE,
  lakecolor = toRGB('white')
)

Introduction

Finally, we can examine the ratio of COVID-19 infections and deaths in Black, Latinx, and White people to the proportion of Black, Latinx, and White people in each state. I calculated each difference and ratio with the following formulas, which generalize to calculations for Latinx, and White people:

\(\begin{align} \text{Proportion of Black People }(P_{b}) &= \frac{\text{2019 Estimated Black Population}}{\text{2019 Estimated Total Population}} \\ \text{Proportion of Black Infections }(P_{b\_infs}) &= \frac{\text{Reported COVID-19 Infections in Black Individuals}}{\text{Total Reported COVID-19 Infections}} \\ \text{Proportion of Black Deaths }(P_{b\_deaths}) &= \frac{\text{Reported COVID-19 Deaths in Black Individuals}}{\text{Total Reported COVID-19 Deaths}} \\ \text{Infection Difference} &= P_{b\_infs} - P_{b} \\ \text{Death Difference} &= P_{b\_deaths} - P_{b} \\ \text{Infection Ratio} &= \frac{P_{b\_infs}}{P_{b}} \\ \text{Death Ratio} &= \frac{P_{b\_deaths}}{P_{b}} \end{align}\)

As of February 10, 2021, COVID-19 infections and deaths are more prevalent among Black individuals than expected given their population proportion in 12 and 19 states respectively. Understanding that the data are likely incomplete and prone to measurement error, and that deaths typically lag behind infections, the infection and death difference is greater than 0.10 in 0 and 1 states respectively and greater than 0.20 in 0 and 1 states respectively. Furthermore, the infection and death ratio is greater than 1.5 in 2 and 2 states respectively and greater than 2 in 2 and 0 states respectively.

Among Latinx individuals, COVID-19 infections and deaths are more prevalent than expected given their population proportion in 25 and 5 states respectively. Understanding that the data are likely incomplete and prone to measurement error, and that deaths typically lag behind infections, the infection and death difference is greater than 0.10 in 1 and 0 states respectively and greater than 0.20 in 0 and 0 states respectively. Furthermore, the infection and death ratio is greater than 1.5 in 7 and 0 states respectively and greater than 2 in 2 and 0 states respectively.

Finally, among White individuals, COVID-19 infections and deaths are more prevalent than expected given their population proportion in 0 and 19 states respectively. Understanding that the data are likely incomplete and prone to measurement error, and that deaths typically lag behind infections, the infection and death difference is greater than 0.10 in 0 and 1 states respectively and greater than 0.20 in 0 and 0 states respectively. Furthermore, the infection and death ratio is greater than 1.5 in 0 and 0 states respectively and greater than 2 in 0 and 0 states respectively.

Tabular Data from February 10, 2021

We can also examine a table of each state, with each variables of interest. We can also directly compare the proportion of Black,Latinx, and White people (\(\blacksquare\)) to the proportion of COVID-19 infections (\(\blacktriangle\)) and deaths () among Black, Latinx, and White people. Each marker’s color represents the median 2015 Area Deprivation Index in each state.

comp_tab <-  data_rec %>% filter(day == max(data_rec$day)) %>%
  mutate(State = abbr2state(state), 
         "2018 Estimated Total Population" = format(tot_pop, big.mark = ","),
         "Total Infections" = format(tot_inf, big.mark = ","),
         "Total Deaths" = format(tot_d, big.mark = ","),
         "Total Black (% Population)" = paste0(format(tot_black, big.mark = ","),
                                               " (", round(tot_black / tot_pop * 100, 2), ")"),
         "Infections in Black People (% Infections)"= paste0(ifelse(!is.na(inf_black), format(inf_black, big.mark = ","),
                                                                    "-"), " (", 
                                                             ifelse(!is.na(prop_b_inf), 
                                                                    round(prop_b_inf*100, 2), "-"), ")"),
         "Deaths in Black People (% Deaths)"= paste0(ifelse(!is.na(d_black), format(d_black, big.mark = ","),
                                                            "-"), " (", 
                                                     ifelse(!is.na(prop_b_d), round(prop_b_d*100, 2), "-"), ")"),
         "Total Latinx (% Population)" = paste0(format(tot_hisp, big.mark = ","),
                                                " (", round(tot_hisp / tot_pop * 100, 2), ")"),
         "Infections in Latinx People (% Infections)"= paste0(ifelse(!is.na(inf_hisp), format(inf_hisp, big.mark = ","),
                                                                     "-"), " (", 
                                                              ifelse(!is.na(prop_l_inf), 
                                                                            round(prop_l_inf*100, 2), "-"), ")"),
         "Deaths in Latinx People (% Deaths)"= paste0(ifelse(!is.na(d_hisp), format(d_hisp, big.mark = ","),
                                                             "-"), " (", 
                                                      ifelse(!is.na(prop_l_d), round(prop_l_d*100, 2), "-"), ")"),
         "Total White (% Population)" = paste0(format(tot_white, big.mark = ","),
                                               " (", round(tot_white / tot_pop * 100, 2), ")"),
         "Infections in White People (% Infections)" = paste0(ifelse(!is.na(inf_white), format(inf_white, big.mark = ","),
                                                                     "-"), " (", 
                                                              ifelse(!is.na(prop_w_inf), 
                                                                     round(prop_nw_inf*100, 2), "-"), ")"),
         "Deaths in White People (% Deaths)" = paste0(ifelse(!is.na(d_white), format(d_white, big.mark = ","),
                                                             "-"), " (", 
                                                      ifelse(!is.na(prop_w_d), round(prop_w_d*100, 2), "-"), ")"),
         "Infections in People of Unknown Race/Ethinicity (% Infections)" = paste0(ifelse(!is.na(inf_unk), 
                                                                                          format(inf_unk, big.mark = ","),
                                                                                          "-"), " (", 
                                                                                   ifelse(!is.na(inf_unk), 
                                                                                          round(inf_unk/tot_inf*100, 2),
                                                                                          "-"), ")"),
         "Deaths in People of Unknown Race/Ethinicity (% Deaths)" = paste0(ifelse(!is.na(d_unk), 
                                                                                  format(d_unk, big.mark = ","),
                                                                                  "-"), " (", 
                                                                                   ifelse(!is.na(d_unk), 
                                                                                          round(d_unk/tot_d*100, 2),
                                                                                          "-"), ")"),
         "2015 Area Deprivation Index" = round(adi, 2)) %>%
  select((ncol(data_rec) + 1):(ncol(data_rec) + 16))

# sort states alphabetically
comp_tab <- comp_tab[order(comp_tab$State),]
rownames(comp_tab) <- comp_tab$State
comp_tab$State <- NULL

comp_tab %>%
  kable(align = "c", format = "html") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = F, font_size = 12) %>%
  footnote(paste0("Data from The COVID Tracking Project (", format(as.Date(data_rec$day[1]), "%B %d, %Y"), ")")) %>%
  scroll_box(height = "400px", fixed_thead = T)

comp_fig <- data.frame(state = fct_rev(as.factor(states$NAME)),
                       adi = states$adi,
                       t_inf = states$inf_tot,
                       t_death = states$death_tot,
                       w_inf = states$inf_w,
                       w_death = states$deaths_w,
                       b_inf = states$inf_b,
                       b_death = states$deaths_b,
                       l_inf = states$inf_l,
                       l_death = states$deaths_l,
                       prop_nw_inf = states$inf_prop_nw,
                       prop_nw_death = states$deaths_prop_nw,
                       prop_nw = states$prop_nw,
                       prop_w_inf = states$inf_prop_w,
                       prop_w_death = states$deaths_prop_w,
                       prop_w = states$prop_w,
                       prop_b_inf = states$inf_prop_b,
                       prop_b_death = states$deaths_prop_b,
                       prop_b = states$prop_b,
                       prop_l_inf = states$inf_prop_l,
                       prop_l_death = states$deaths_prop_l,
                       prop_l = states$prop_l)

# make it long form
comp_fig_plot <- comp_fig %>% gather("Type", "value", prop_nw_inf:prop_l)

# add "group" column
comp_fig_plot$group <- NA
for(i in 1:nrow(comp_fig_plot)){
  if(str_detect(comp_fig_plot$Type[i], "_nw")){
    comp_fig_plot$group[i] <- "Non-White"
  }
  if(str_detect(comp_fig_plot$Type[i], "_w")){
    comp_fig_plot$group[i] <- "White"
  }
  if(str_detect(comp_fig_plot$Type[i], "_b")){
    comp_fig_plot$group[i] <- "Black"
  }
  if(str_detect(comp_fig_plot$Type[i], "_l")){
    comp_fig_plot$group[i] <- "Latinx"
  }
}

# add rounded colum for label
comp_fig_plot$proportion <- round(comp_fig_plot$value, 2)

# make nicer labels
comp_fig_plot$type <- NA
comp_fig_plot[comp_fig_plot$Type == "prop_nw_inf" |
                comp_fig_plot$Type == "prop_w_inf" |
                comp_fig_plot$Type == "prop_b_inf" |
                comp_fig_plot$Type == "prop_l_inf", ]$type <- "Proportion of Infections"
comp_fig_plot[comp_fig_plot$Type == "prop_nw_death" |
                comp_fig_plot$Type == "prop_w_death" |
                comp_fig_plot$Type == "prop_b_death" |
                comp_fig_plot$Type == "prop_l_death", ]$type <- "Proportion of Deaths"
comp_fig_plot[comp_fig_plot$Type == "prop_nw" |
                comp_fig_plot$Type == "prop_w" |
                comp_fig_plot$Type == "prop_b" |
                comp_fig_plot$Type == "prop_l", ]$type <- "Proportion of People"

# remove non-white
comp_fig_plot<- comp_fig_plot[comp_fig_plot$group != "Non-White", ]

# add column with cases
# little function to do it
sort_cases_comp <- function(case_type, i) {
  if(str_detect(case_type, "inf") & str_detect(case_type, "_w_")) {return(comp_fig_plot$w_inf[i])}
  if(str_detect(case_type, "inf") & str_detect(case_type, "_b")) {return(comp_fig_plot$b_inf[i])}
  if(str_detect(case_type, "inf") & str_detect(case_type, "_l")) {return(comp_fig_plot$l_inf[i])}
  if(str_detect(case_type, "_d") & str_detect(case_type, "_w")) {return(comp_fig_plot$w_death[i])}
  if(str_detect(case_type, "_d") & str_detect(case_type, "_b")) {return(comp_fig_plot$b_death[i])}
  if(str_detect(case_type, "_d") & str_detect(case_type, "_l")) {return(comp_fig_plot$l_death[i])}
  if(str_detect(case_type, "prop")){return(paste0("total infections: ", comp_fig_plot$t_inf[i], "\n", 
                                               "total deaths: ", comp_fig_plot$t_death[i]))}
}

# loop through (this is a slow way to do it...)
for(i in 1:nrow(comp_fig_plot)){
  comp_fig_plot$cases[i] <- sort_cases_comp(comp_fig_plot$Type[i], i)
}

d1 <- ggplot(comp_fig_plot) + 
  geom_point(aes(x = state, y = value, shape = type, label = proportion, color = adi, 
                   text = paste0(ifelse(str_detect(type, "Inf"), "infections: ", 
                                        ifelse(str_detect(type, "Dea"), "deaths:", "")), cases))) + 
  facet_wrap(~group) +
  coord_flip() + 
  ggtitle(paste0("Infection and Death Proportions by Race/Ethnicity (", format(as.Date(data_rec$day[1]), "%B %d, %Y"), ")")) + 
  ylab("") + 
  xlab("") + 
  ylim(0, 1) +
  scale_color_gradient(low = "#ffffcc", high = "#bd0026") +
  theme(plot.title = element_text(hjust = 0.5), 
        panel.background = element_rect(fill = NA), 
        panel.grid = element_line(color = "grey75"), 
        legend.key = element_rect(fill = NA), 
        legend.position = "top", 
        legend.title = element_blank()) +
  labs(color = "Area Deprivation Index, 2015")

ggplotly(d1, width = 1100, height = 1100, tooltip = c("x", "shape", "label", "colour", "text"))

Maps from February 10, 2021

We can also compare the most recent The COVID Tracking Project data with the 2015 Area Deprivation Index and the 2019 estimated proportion of Black, Latinx, and White people in each state. The left column shows the most recent infection difference data (February 10, 2021) for Black, Latinx, and White people as compared to their population proportion in each state (right column). The more red a state is, the greater the difference of Black, Latinx, and White COVID-19 infections to Black, Latinx, and White people in a state.

# exclude AK and HI for map
states_cont <- states[states$STUSPS %nin% c("AK", "HI"), ]

# create common theme
theme_map <- theme(plot.title = element_text(hjust = 0.5), legend.position = "right", 
        legend.key = element_rect(fill = NA), legend.text = element_text(size = 6.5), 
        legend.key.size = unit(0.5,"line"), axis.text.x = element_blank(), 
        axis.text.y = element_blank(), axis.ticks.x = element_blank(), 
        axis.ticks.y = element_blank(), axis.title.x = element_blank(), 
        axis.title.y = element_blank(), panel.background = element_blank(),
        panel.grid.major = element_blank(), panel.grid.minor = element_blank())

p1 <- ggplot() + geom_sf(data = states_cont, aes(fill = inf_diff_b)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) + 
  ggtitle(paste("COVID-19 Infection Difference*\nin Black Individuals\n",
                format(data_rec$day[1], "%B %d, %Y"))) +
  labs(fill = "Difference") +
  theme_map
p2 <- ggplot() + geom_sf(data = states_cont, aes(fill = prop_b)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) +
  ggtitle("Estimated Proportion of Black Individuals, 2019") +
  labs(fill = "Proportion") +
  theme_map
p3 <- ggplot() + geom_sf(data = states_cont, aes(fill = inf_diff_l)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) + 
  ggtitle(paste("COVID-19 Infection Difference*\nin Latinx Individuals\n",
                format(data_rec$day[1], "%B %d, %Y"))) +
  labs(fill = "Difference") +
  theme_map
p4 <- ggplot() + geom_sf(data = states_cont, aes(fill = prop_l)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) +
  ggtitle("Estimated Proportion of Latinx Individuals, 2019") +
  labs(fill = "Proportion") +
  theme_map
p5 <- ggplot() + geom_sf(data = states_cont, aes(fill = inf_diff_w)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) + 
  ggtitle(paste("COVID-19 Infection Difference*\nin White Individuals\n",
                format(data_rec$day[1], "%B %d, %Y"))) +
  labs(fill = "Difference") +
  theme_map
p6 <- ggplot() + geom_sf(data = states_cont, aes(fill = prop_w)) +
  scale_fill_distiller(palette = "YlOrRd", direction = 1) +
  ggtitle("Estimated Proportion of White Individuals, 2019") +
  labs(fill = "Proportion") +
  theme_map

gridExtra::grid.arrange(p1, p2, p3, p4, p5, p6, 
                        nrow = 3,
                        bottom = text_grob("*Difference in Proportion of COVID-19 Infections\nto Population Proportion",
                                           just = "left"))

Trends in Differences and Ratios

Finally COVID-19 infection and death differences and ratios are plotted by state over time. The colors represent the median 2015 Area Deprivation Index in each state and have the same scale as above, where darker colors indicate a higher percentile of area deprivation. As an example, in Tennessee, where I am based, as of February 10, 2021 there were 46623 infections among Latinx people, which represented 0.06 of all infections in Tennessee. However, Latinx people only make up 0.06 of all people living in Tennessee, so the infection difference is 0.06 - 0.06, which equals 0, and the infection ratio is 0.06/0.06, which equals 1.08.

The infection and death differences/ratios are flat or increasing over time in the majority of states, although any interpretation should be mindful that data may not be reported consistently from one date to the next. Furthermore, given very striking inequities in some states, other states may appear to be doing relatively well by comparison, however, when you hover over the raw values you will see there is still obvious evidence of health inequities in most states, which suggests deeply entrenched forces and/or structures, including systemic racism, underlying these inequities.

To compare COVID-19 health inequities across states on one plot, please visit https://dannysack.shinyapps.io/covid_inequities/ (please note, it can take a minute for the server to wake up).

# make long form verions of infection proportion differences
data_inf_diff <- data %>% gather("type", "value", inf_diff_nw:inf_diff_l) %>%
  select(date, state, inf_white, inf_black, inf_hisp, d_white, d_black, d_hisp, type, value, adi)

# add "group" column
data_inf_diff$group <- NA
for(i in 1:nrow(data_inf_diff)){
  if(str_detect(data_inf_diff$type[i], "_nw")){
    data_inf_diff$group[i] <- "Non-White"
  }
  if(str_detect(data_inf_diff$type[i], "_w")){
    data_inf_diff$group[i] <- "White"
  }
  if(str_detect(data_inf_diff$type[i], "_b")){
    data_inf_diff$group[i] <- "Black"
  }
  if(str_detect(data_inf_diff$type[i], "_l")){
    data_inf_diff$group[i] <- "Latinx"
  }
}

# add rounded colum for label
data_inf_diff$difference <- round(data_inf_diff$value, 2)

# make nicer labels
data_inf_diff$measure <- NA
data_inf_diff[data_inf_diff$type == "inf_diff_nw" |
                data_inf_diff$type == "inf_diff_w" |
                data_inf_diff$type == "inf_diff_b" |
                data_inf_diff$type == "inf_diff_l", ]$measure <- "Infection Difference"

# remove non-white rows
data_inf_diff <- data_inf_diff[data_inf_diff$group != "Non-White", ]

# now get the correct value into a new column, "cases"
for(i in 1:nrow(data_inf_diff)) {
  if(str_detect(data_inf_diff$type[i], "inf") & str_detect(data_inf_diff$type[i], "_w")) {
    data_inf_diff$cases[i] <- data_inf_diff$inf_white[i]}
  if(str_detect(data_inf_diff$type[i], "inf") & str_detect(data_inf_diff$type[i], "_b")) {
    data_inf_diff$cases[i] <- data_inf_diff$inf_black[i]}
  if(str_detect(data_inf_diff$type[i], "inf") & str_detect(data_inf_diff$type[i], "_l")) {
    data_inf_diff$cases[i] <- data_inf_diff$inf_hisp[i]}
}

f1 <- ggplot(data_inf_diff) + 
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  geom_point(aes(x = date, y = value, color = adi, label = difference, 
                                             name = measure, text = paste0("infections: ", cases))) +
  facet_grid(state ~ group, switch = "y") + 
  ggtitle("Differences in COVID-19 Infections") +
  xlab("Date (hover for date)") +
  ylab("Difference") +
  scale_color_gradient(low = "#ffffcc", high = "#bd0026") +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "bottom",
        legend.direction = "horizontal") +
  labs(color = "Area Deprivation Index, 2015") 

# make long form verions of death proportion differences
data_d_diff <- data %>% gather("type", "value", d_diff_nw:d_diff_l) %>%
  select(date, state, inf_white, inf_black, inf_hisp, d_white, d_black, d_hisp, type, value, adi)

# add "group" column
data_d_diff$group <- NA
for(i in 1:nrow(data_d_diff)){
  if(str_detect(data_d_diff$type[i], "_nw")){
    data_d_diff$group[i] <- "Non-White"
  }
  if(str_detect(data_d_diff$type[i], "_w")){
    data_d_diff$group[i] <- "White"
  }
  if(str_detect(data_d_diff$type[i], "_b")){
    data_d_diff$group[i] <- "Black"
  }
  if(str_detect(data_d_diff$type[i], "_l")){
    data_d_diff$group[i] <- "Latinx"
  }
}

# add rounded colum for label
data_d_diff$difference <- round(data_d_diff$value, 2)

# make nicer labels
data_d_diff$measure <- NA
data_d_diff[data_d_diff$type == "d_diff_nw" |
                data_d_diff$type == "d_diff_w" |
                data_d_diff$type == "d_diff_b" |
                data_d_diff$type == "d_diff_l", ]$measure <- "Death Difference"

# remove non-white rows
data_d_diff <- data_d_diff[data_d_diff$group != "Non-White", ]

# now get the correct value into a new column, "cases"
for(i in 1:nrow(data_d_diff)) {
  if(str_detect(data_d_diff$type[i], "d_") & str_detect(data_d_diff$type[i], "_w")) {
    data_d_diff$cases[i] <- data_d_diff$d_white[i]}
  if(str_detect(data_d_diff$type[i], "d_") & str_detect(data_d_diff$type[i], "_b")) {
    data_d_diff$cases[i] <- data_d_diff$d_black[i]}
  if(str_detect(data_d_diff$type[i], "d_") & str_detect(data_d_diff$type[i], "_l")) {
    data_d_diff$cases[i] <- data_d_diff$d_hisp[i]}
}

f2 <- ggplot(data_d_diff) + 
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  geom_point(aes(x = date, y = value, color = adi, label = difference, 
                                             name = measure, text = paste0("deaths: ", cases))) +
  facet_grid(state ~ group, switch = "y") + 
  ggtitle("Differences in COVID-19 Deaths") +
  xlab("Date (hover for date)") +
  ylab("Difference") +
  scale_color_gradient(low = "#ffffcc", high = "#bd0026") +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "bottom",
        legend.direction = "horizontal") +
  labs(color = "Area Deprivation Index, 2015") 

# make long form verions of infection proportion differences
data_inf_ratio <- data %>% gather("type", "value", inf_ratio_nw:inf_ratio_l) %>%
  select(date, state, inf_white, inf_black, inf_hisp, d_white, d_black, d_hisp, type, value, adi)

# add "group" column
data_inf_ratio$group <- NA
for(i in 1:nrow(data_inf_ratio)){
  if(str_detect(data_inf_ratio$type[i], "_nw")){
    data_inf_ratio$group[i] <- "Non-White"
  }
  if(str_detect(data_inf_ratio$type[i], "_w")){
    data_inf_ratio$group[i] <- "White"
  }
  if(str_detect(data_inf_ratio$type[i], "_b")){
    data_inf_ratio$group[i] <- "Black"
  }
  if(str_detect(data_inf_ratio$type[i], "_l")){
    data_inf_ratio$group[i] <- "Latinx"
  }
}

# add rounded colum for label
data_inf_ratio$ratio <- round(data_inf_ratio$value, 2)

# make nicer labels
data_inf_ratio$measure <- NA
data_inf_ratio[data_inf_ratio$type == "inf_ratio_nw" |
                data_inf_ratio$type == "inf_ratio_w" |
                data_inf_ratio$type == "inf_ratio_b" |
                data_inf_ratio$type == "inf_ratio_l", ]$measure <- "Infection Ratio"

# remove non-white rows
data_inf_ratio <- data_inf_ratio[data_inf_ratio$group != "Non-White", ]

# now get the correct value into a new column, "cases"
for(i in 1:nrow(data_inf_ratio)) {
  if(str_detect(data_inf_ratio$type[i], "inf") & str_detect(data_inf_ratio$type[i], "_w")) {
    data_inf_ratio$cases[i] <- data_inf_ratio$inf_white[i]}
  if(str_detect(data_inf_ratio$type[i], "inf") & str_detect(data_inf_ratio$type[i], "_b")) {
    data_inf_ratio$cases[i] <- data_inf_ratio$inf_black[i]}
  if(str_detect(data_inf_ratio$type[i], "inf") & str_detect(data_inf_ratio$type[i], "_l")) {
    data_inf_ratio$cases[i] <- data_inf_ratio$inf_hisp[i]}
}

f3 <- ggplot(data_inf_ratio) + 
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  geom_point(aes(x = date, y = value, color = adi, label = ratio, 
                                             name = measure, text = paste0("infections: ", cases))) +
  facet_grid(state ~ group, switch = "y") + 
  ggtitle("Ratios in COVID-19 Infections") +
  xlab("Date (hover for date)") +
  ylab("Ratio") +
  scale_color_gradient(low = "#ffffcc", high = "#bd0026") +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "bottom",
        legend.direction = "horizontal") +
  labs(color = "Area Deprivation Index, 2015")

# make long form verions of death proportion differences
data_d_ratio <- data %>% gather("type", "value", d_ratio_nw:d_ratio_l) %>%
  select(date, state, inf_white, inf_black, inf_hisp, d_white, d_black, d_hisp, type, value, adi)

# add "group" column
data_d_ratio$group <- NA
for(i in 1:nrow(data_d_ratio)){
  if(str_detect(data_d_ratio$type[i], "_nw")){
    data_d_ratio$group[i] <- "Non-White"
  }
  if(str_detect(data_d_ratio$type[i], "_w")){
    data_d_ratio$group[i] <- "White"
  }
  if(str_detect(data_d_ratio$type[i], "_b")){
    data_d_ratio$group[i] <- "Black"
  }
  if(str_detect(data_d_ratio$type[i], "_l")){
    data_d_ratio$group[i] <- "Latinx"
  }
}

# add rounded colum for label
data_d_ratio$ratio <- round(data_d_ratio$value, 2)

# make nicer labels
data_d_ratio$measure <- NA
data_d_ratio[data_d_ratio$type == "d_ratio_nw" |
                data_d_ratio$type == "d_ratio_w" |
                data_d_ratio$type == "d_ratio_b" |
                data_d_ratio$type == "d_ratio_l", ]$measure <- "Death Ratio"

# remove non-white rows
data_d_ratio <- data_d_ratio[data_d_ratio$group != "Non-White", ]

for(i in 1:nrow(data_d_ratio)) {
  if(str_detect(data_d_ratio$type[i], "d_") & str_detect(data_d_ratio$type[i], "_w")) {
    data_d_ratio$cases[i] <- data_d_ratio$d_white[i]}
  if(str_detect(data_d_ratio$type[i], "d_") & str_detect(data_d_ratio$type[i], "_b")) {
    data_d_ratio$cases[i] <- data_d_ratio$d_black[i]}
  if(str_detect(data_d_ratio$type[i], "d_") & str_detect(data_d_ratio$type[i], "_l")) {
    data_d_ratio$cases[i] <- data_d_ratio$d_hisp[i]}
}

f4 <- ggplot(data_d_ratio) + 
  geom_hline(yintercept = 0, linetype = "dashed", color = "red") +
  geom_point(aes(x = date, y = value, color = adi, label = ratio, 
                                             name = measure, text = paste0("deaths: ", cases))) +
  facet_grid(state ~ group, switch = "y") + 
  ggtitle("Ratios in COVID-19 Deaths") +
  xlab("Date (hover for date)") +
  ylab("Ratio") +
  scale_color_gradient(low = "#ffffcc", high = "#bd0026") +
  theme_bw() +
  theme(axis.text.x = element_blank(),
        axis.ticks.x = element_blank(),
        plot.title = element_text(hjust = 0.5),
        legend.position = "bottom",
        legend.direction = "horizontal") +
  labs(color = "Area Deprivation Index, 2015") 

ggplotly(f1, width = 800, height = 4000, tooltip = c("name", "x", "label", "colour", "text")) %>% hide_colorbar()

ggplotly(f2, width = 800, height = 4000, tooltip = c("name", "x", "label", "colour", "text")) %>% hide_colorbar()

ggplotly(f3, width = 800, height = 4000, tooltip = c("name", "x", "label", "colour", "text")) %>% hide_colorbar()

ggplotly(f4, width = 800, height = 4000, tooltip = c("name", "x", "label", "colour", "text")) %>% hide_colorbar()