Alice Tivarovsky

Useful Resources

Alice Tivarovsky — Sat, 02 Sep 2023 00:00:00 GMT

As I’ve spent more time in R, I’ve come to realize the value of a repository of good resources to refer back to when I’m solving a problem. The following is my (growing) list of books and posts I’ve come back to over the years.

Data Science, Programming & R

I refer back to Hadley Wickham and Garrett Grolemund’s R for Data Science at work and for this blog all the time. As impressed as I was by the text as a master’s student, I am even more impressed by how comprehensive and helpful it is in the “real world”.
RStudio Cheatsheets are great for quick reference for most major packages.
R-bloggers is a great way to keep up with what’s going on and learn from other R users.
Even if computer science is not directly in your domain, Harvard’s CS50 on edX is eye-opening.
If you’re a beginner and want to get your feet wet and start to develop some muscle memory, DataCamp has some nice courses. I personally think investing time in actual projects is more bang for your buck, but sometimes you just want to do a few coding exercises.
If you’re doing any kind of data work in R, chances are you’ll want to make tables. Don’t settle for sub-par looking tables. Use the kableExtra package.
This is more specific to public health, but The Epidemiologist R Handbook is a great reference.

Statistics

If you’re looking for something not too technical, or you’re just starting out, Discovering Statistics Using R is a highly accessible (and often funny) text to work through.
If you’re specifically interested in Biostatistics, Fundamentals of Biostatistics is essential reading.

Blogging & Hugo

Creating Websites with R Markdown is incredibly accessible to beginners and should be a prerequisite for using blogdown.
Hugo has a huge repository of documents and I’ve been able to answer a lot of my more detailed questions by just typing keywords into the search bar.

Statistics Concept Map

Alice Tivarovsky — Mon, 28 Nov 2022 00:00:00 GMT

Motivation

I was recently reflecting on my graduate school experience and trying to answer the “was it worth it” question. With the incredible amount of free educational resources online, why did I instead sacrifice my life’s savings to the overlords of higher education? And now that I’m a few years out and in the “real world”, do I think that money and time was worth it?

The short answer, for me, is yes. For one thing, it would have been tough to find a job as an Epidemiologist with no prior experience and a bachelor’s degree in a totally different field. It gave me some credibility, a starter network, and a sense of what this field actually is and which parts of it I’m interested in.

The other very valuable thing it provided was a “map” in my mind of the concepts we were taught. It’s not that I remember every course (in fact, I’ve probably forgotten more than half of what I learned). But I have an idea of what concepts exist, a rough sense of how they relate to one another, and where to look when I’m solving a problem.

It’s kind of like an actual map. You probably don’t know what cities exist in Iowa, or even the exact placement of the streets in your neighborhood. But you have some intuition of where your neighborhood is in your city, where your city is in the world, where Iowa is the U.S., and the details you can always find on an actual map.

I think this is an apt analogy for the educational value of my master’s degree. Doing this online would have been tough. Piecing together a curriculum, finding quality courses, and having knowledgeable people around to answer questions was pretty valuable.

With that in mind, I endeavored to do a quick review of my statistics coursework - I enjoyed stats classes very much - and I figured the best way to do that would be to jot out a concept map. This ended up taking quite a bit longer than I thought - it’s unsettling how much I forgot in 2.5 years. Nevertheless, it provided a very useful memory re-fresh, and gave a bit more resolution to that map floating in my mind.

Concept Map

Here’s the semi-finished product. I will probably refine it over time, so we can call this a first draft.

Adding Subset Buttons to plot_ly Plots

Alice Tivarovsky — Sun, 18 Sep 2022 00:00:00 GMT

Motivation

I recently found myself drafting some plotly figures for work, and I wanted to add a bit more interactivity without creating a shiny app. I plotted time-series data and I wanted the end user to be able to subset the plot to a year of their choosing, or to see the entire range of time in one figure.

After a bit of googling around, I found a few solutions, but this one suited my needs the best. These buttons are straight-forward for the user and pretty simple to code up. Below is a quick demo.

Data Preparation

library(tidyverse)
library(plotly)

We’ll be using Covid-19 case data in the United States, downloaded from Our World in Data.

raw_data <- 
  read.csv("data/owid-covid-data.csv", header = TRUE) 

head(raw_data)

  iso_code continent    location       date total_cases new_cases
1      AFG      Asia Afghanistan 2020-02-24           5         5
2      AFG      Asia Afghanistan 2020-02-25           5         0
3      AFG      Asia Afghanistan 2020-02-26           5         0
4      AFG      Asia Afghanistan 2020-02-27           5         0
5      AFG      Asia Afghanistan 2020-02-28           5         0
6      AFG      Asia Afghanistan 2020-02-29           5         0
  new_cases_smoothed total_deaths new_deaths new_deaths_smoothed
1                 NA           NA         NA                  NA
2                 NA           NA         NA                  NA
3                 NA           NA         NA                  NA
4                 NA           NA         NA                  NA
5                 NA           NA         NA                  NA
6              0.714           NA         NA                  NA
  total_cases_per_million new_cases_per_million new_cases_smoothed_per_million
1                   0.125                 0.125                             NA
2                   0.125                 0.000                             NA
3                   0.125                 0.000                             NA
4                   0.125                 0.000                             NA
5                   0.125                 0.000                             NA
6                   0.125                 0.000                          0.018
  total_deaths_per_million new_deaths_per_million
1                       NA                     NA
2                       NA                     NA
3                       NA                     NA
4                       NA                     NA
5                       NA                     NA
6                       NA                     NA
  new_deaths_smoothed_per_million reproduction_rate icu_patients
1                              NA                NA           NA
2                              NA                NA           NA
3                              NA                NA           NA
4                              NA                NA           NA
5                              NA                NA           NA
6                              NA                NA           NA
  icu_patients_per_million hosp_patients hosp_patients_per_million
1                       NA            NA                        NA
2                       NA            NA                        NA
3                       NA            NA                        NA
4                       NA            NA                        NA
5                       NA            NA                        NA
6                       NA            NA                        NA
  weekly_icu_admissions weekly_icu_admissions_per_million
1                    NA                                NA
2                    NA                                NA
3                    NA                                NA
4                    NA                                NA
5                    NA                                NA
6                    NA                                NA
  weekly_hosp_admissions weekly_hosp_admissions_per_million total_tests
1                     NA                                 NA          NA
2                     NA                                 NA          NA
3                     NA                                 NA          NA
4                     NA                                 NA          NA
5                     NA                                 NA          NA
6                     NA                                 NA          NA
  new_tests total_tests_per_thousand new_tests_per_thousand new_tests_smoothed
1        NA                       NA                     NA                 NA
2        NA                       NA                     NA                 NA
3        NA                       NA                     NA                 NA
4        NA                       NA                     NA                 NA
5        NA                       NA                     NA                 NA
6        NA                       NA                     NA                 NA
  new_tests_smoothed_per_thousand positive_rate tests_per_case tests_units
1                              NA            NA             NA            
2                              NA            NA             NA            
3                              NA            NA             NA            
4                              NA            NA             NA            
5                              NA            NA             NA            
6                              NA            NA             NA            
  total_vaccinations people_vaccinated people_fully_vaccinated total_boosters
1                 NA                NA                      NA             NA
2                 NA                NA                      NA             NA
3                 NA                NA                      NA             NA
4                 NA                NA                      NA             NA
5                 NA                NA                      NA             NA
6                 NA                NA                      NA             NA
  new_vaccinations new_vaccinations_smoothed total_vaccinations_per_hundred
1               NA                        NA                             NA
2               NA                        NA                             NA
3               NA                        NA                             NA
4               NA                        NA                             NA
5               NA                        NA                             NA
6               NA                        NA                             NA
  people_vaccinated_per_hundred people_fully_vaccinated_per_hundred
1                            NA                                  NA
2                            NA                                  NA
3                            NA                                  NA
4                            NA                                  NA
5                            NA                                  NA
6                            NA                                  NA
  total_boosters_per_hundred new_vaccinations_smoothed_per_million
1                         NA                                    NA
2                         NA                                    NA
3                         NA                                    NA
4                         NA                                    NA
5                         NA                                    NA
6                         NA                                    NA
  new_people_vaccinated_smoothed new_people_vaccinated_smoothed_per_hundred
1                             NA                                         NA
2                             NA                                         NA
3                             NA                                         NA
4                             NA                                         NA
5                             NA                                         NA
6                             NA                                         NA
  stringency_index population population_density median_age aged_65_older
1             8.33   40099462             54.422       18.6         2.581
2             8.33   40099462             54.422       18.6         2.581
3             8.33   40099462             54.422       18.6         2.581
4             8.33   40099462             54.422       18.6         2.581
5             8.33   40099462             54.422       18.6         2.581
6             8.33   40099462             54.422       18.6         2.581
  aged_70_older gdp_per_capita extreme_poverty cardiovasc_death_rate
1         1.337       1803.987              NA               597.029
2         1.337       1803.987              NA               597.029
3         1.337       1803.987              NA               597.029
4         1.337       1803.987              NA               597.029
5         1.337       1803.987              NA               597.029
6         1.337       1803.987              NA               597.029
  diabetes_prevalence female_smokers male_smokers handwashing_facilities
1                9.59             NA           NA                 37.746
2                9.59             NA           NA                 37.746
3                9.59             NA           NA                 37.746
4                9.59             NA           NA                 37.746
5                9.59             NA           NA                 37.746
6                9.59             NA           NA                 37.746
  hospital_beds_per_thousand life_expectancy human_development_index
1                        0.5           64.83                   0.511
2                        0.5           64.83                   0.511
3                        0.5           64.83                   0.511
4                        0.5           64.83                   0.511
5                        0.5           64.83                   0.511
6                        0.5           64.83                   0.511
  excess_mortality_cumulative_absolute excess_mortality_cumulative
1                                   NA                          NA
2                                   NA                          NA
3                                   NA                          NA
4                                   NA                          NA
5                                   NA                          NA
6                                   NA                          NA
  excess_mortality excess_mortality_cumulative_per_million
1               NA                                      NA
2               NA                                      NA
3               NA                                      NA
4               NA                                      NA
5               NA                                      NA
6               NA                                      NA

Next, we’ll limit to United States data points, and select only the necessary columns. We’ll use new_cases_smoothed (smoothed over the week of data) to avoid the noise of daily fluctuation around the line. We’ll also fix the variable class of date.

us_df <- 
  raw_data %>% 
  select(location, date, new_cases_smoothed) %>% 
  filter(location == "United States") %>% 
  mutate(date = as.POSIXct(date))

us_df %>% 
  filter(!is.na(new_cases_smoothed)) %>% 
  head()

       location       date new_cases_smoothed
1 United States 2020-01-28              0.571
2 United States 2020-01-29              0.714
3 United States 2020-01-30              0.714
4 United States 2020-01-31              0.857
5 United States 2020-02-01              0.857
6 United States 2020-02-02              0.429

# huge file, remove to save memory
rm(raw_data)

Analysis

We will start by plotting a regular plotly figure, as a “before” shot, if you will.

regular_plot <- 
  us_df %>% 
  plot_ly(x = ~date) %>% 
  add_lines(y = ~new_cases_smoothed) %>% 
  layout(title = "Covid-19 Incidence in the US", 
         yaxis = list(title = "New Cases (Smoothed)"))

regular_plot

Now, we’ll apply the buttons. To do this, we will use an updatemenu relayout method, as detailed here. There are several methods, but relayout is the one most appropriate, since it will allow the user to modify a layout attribute, in this case the range of the x-axis.

button_plot <- 
  us_df %>% 
  plot_ly(x = ~date) %>% 
  add_lines(y = ~new_cases_smoothed) %>% 
  layout(
    title = "Covid-19 Incidence in the US", 
    yaxis = list(title = "New Cases (Smoothed)"),
    updatemenus = list(
      list(type = "buttons",
           buttons = list(list(label = "All", 
                              method = "relayout", 
                              args = list(list(xaxis = list(range = c("2020-01-01","2022-12-31"))))),
                           list(label = "2020", 
                                method = "relayout", 
                                args = list(list(xaxis = list(range = c("2020-01-01","2020-12-31"))))),
                          list(label = "2021", 
                                method = "relayout", 
                                args = list(list(xaxis = list(range = c("2021-01-01","2021-12-31"))))),
                          list(label = "2022", 
                                method = "relayout", 
                                args = list(list(xaxis = list(range = c("2022-01-01","2022-12-31")))))
                          ))))

button_plot

Conclusion

And that’s it! We took a plotly figure and made it even more functional with a few easy-to-code controls. Just when I thought I knew the ins and outs of plotly, it surprised me with a sweet feature I’ve never seen.

Cleaning Messy Strings Using stringr and Regular Expressions

Alice Tivarovsky — Sun, 18 Sep 2022 00:00:00 GMT

Motivation

I recently completed several projects that involved cleaning lots of messy data, in particular, free text strings that I needed to organize into tidy variables and text-mine for insights. To do this efficiently, I learned how to use regular expressions (regexps), as suggested by Hadley Wickham and Garrett Grolemund’s in R for Data Science.

As the authors suggest, it takes a little while to learn the rules of regexps and get comfortable using them, but once you do, you’ll see they’re a powerful tool to have in your data cleaning toolbox. The best resources I found for learning and practicing regexps are the RStudio stringr cheatsheet (found here) and this handy interactive program.

Below is a bit of practice with stringr and regexps using Wikipedia’s list of tallest people on record. I realize this is not exactly a health topic, but it’s a simple motivating example that can be leveraged to any messy dataset containing strings. We’ll be using the rvest package to scrape an html table from the Wikipedia page, as outlined here and here.

Import

The original table looks like this:

The steps below scrape the data using rvest.

# wikipedia source url
url <- 'https://en.wikipedia.org/wiki/List_of_tallest_people'

# grab the first table on the page
tall_table <- 
  url %>% 
  read_html() %>% 
  html_element("table.wikitable") %>% 
  html_table()

tall_table <- 
  tall_table %>% 
  janitor::clean_names()

tall_table %>% 
  select(c(metric, lifespan_age_at_death, imperial, note))

# A tibble: 219 × 4
   metric lifespan_age_at_death imperial   note                                 
                                                            
 1 272 cm 1918–1940 (22)        8 ft 11 in Tallest verified human in recorded h…
 2 267 cm 1867–1905 (38)        8 ft 9 in  Second tallest man in recorded histo…
 3 264 cm 1932–1969 (37)        8 ft 8 in  8 ft 0 in (244 cm) standing height, …
 4 262 cm 1924–1943 (18)        8 ft 7 in  Though billed at 8 ft 7 in (262 cm),…
 5 259 cm 1913–1948 (24–25)     8 ft 6 in  Suffered from Proteus syndrome.      
 6 258 cm 1600–1649 (48–49)     8 ft 6 in  Tallest sumo wrestler and first Yoko…
 7 258 cm 1924/25–1944(19–20)   8 ft 6 in  Not officially recognized by Guinnes…
 8 257 cm 1984–2019 (34)        8 ft 5 in  He was reported post mortem to be 9 …
 9 257 cm 1989–2015 (26)        8 ft 5 in  Not recognized by Guinness World Rec…
10 254 cm 1897–1921 (23)        8 ft 4 in  Coyne's World War I draft registrati…
# ℹ 209 more rows

Clearly this requires some data cleaning. Specifically, we need to address the following problems:
- The variables metric and imperial mix numbers and text to express height in their respective units
- The lifespan_age_at_death variable combines three numeric variables into one column
- The note columns often contains reference numbers in brackets

Tidy

1. The `metric` Variable

First we’ll clean up metric by removing the “cm” on the end of every observation, converting it to a numeric variable, and updating the variable name.

# remove "cm"
tall_table_1 <- 
  tall_table %>% 
  mutate(metric = str_replace(metric, "cm", ""))

head(tall_table_1$metric)

[1] "272 " "267 " "264 " "262 " "259 " "258 "

Here we run into our first problem: trailing blanks. When we removed “cm” from the strings, we created phantom blanks, as evidenced by the space between the last digit and the end quote. These will prevent us from cleanly coercing the characters to numbers:

tall_table_test <- 
  tall_table_1 %>% 
  mutate(metric = as.numeric(metric))

head(tall_table_test$metric)

[1] 272 267 264 262 259 258

This is very easy to fix with str_trim:

# trim trailing blanks
tall_table_2 <- 
  tall_table_1 %>% 
  mutate(metric = str_trim(metric, side = "both"), 
         metric = as.numeric(metric)) %>% 
  rename(ht_cm = metric)
  
tall_table_2$ht_cm

  [1] 272 267 264 262 259 258 258 257 257 254 252 251 251 251 251 249 246 246
 [19] 246 246 246 245 245 245 244 244 244 244 244 244 242 242 242 242 241 241
 [37] 241 240 240 240 240 239 238 238 237 236 236 236 236 236 236 236 236 236
 [55] 236 236 236 236 236 236 235 235 235 235 235 235 235 234 234 234 234 234
 [73] 234 234 234 234 234 234 233 233 233 233 233 232 232 232 231 231 231 231
 [91] 231 231 231 231 231 230 230 230 230 229 229 229 229 229 229 229 229 229
[109] 229 229 229 229 229 229 229 229 229 229 229 229 229 228 228 228 228 228
[127] 228 228 228 227 226 226 226 226 226 226 226 226 226 226 225 225 225 225
[145] 225 225 225 224 224 224 224 224 224 224 224 224 224 224 224 223 223 223
[163] 223 223 223 223 223 222 222 222 222 222 222 222 222 222 222 221 221 221
[181] 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221
[199] 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221 221 220 220
[217] 220 220 220

Now we move on to the imperial variable, which takes on the following (un-tidy) values:

tall_table_2$imperial

  [1] "8 ft 11 in" "8 ft 9 in"  "8 ft 8 in"  "8 ft 7 in"  "8 ft 6 in" 
  [6] "8 ft 6 in"  "8 ft 6 in"  "8 ft 5 in"  "8 ft 5 in"  "8 ft 4 in" 
 [11] "8 ft 3 in"  "8 ft 3 in"  "8 ft 3 in"  "8 ft 3 in"  "8 ft 3 in" 
 [16] "8 ft 2 in"  "8 ft 1 in"  "8 ft 1 in"  "8 ft 1 in"  "8 ft 1 in" 
 [21] "8 ft 1 in"  "8 ft 0 in"  "8 ft 0 in"  "8 ft 0 in"  "8 ft 0 in" 
 [26] "8 ft 0 in"  "8 ft 0 in"  "8 ft 0 in"  "8 ft 0 in"  "8 ft 0 in" 
 [31] "7 ft 11 in" "7 ft 11 in" "7 ft 11 in" "7 ft 11 in" "7 ft 11 in"
 [36] "7 ft 11 in" "7 ft 11 in" "7 ft 10 in" "7 ft 10 in" "7 ft 10 in"
 [41] "7 ft 10 in" "7 ft 10 in" "7 ft 10 in" "7 ft 10 in" "7 ft 10 in"
 [46] "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft  9 in" "7 ft 9 in" 
 [51] "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in" 
 [56] "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in" 
 [61] "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in"  "7 ft 9 in" 
 [66] "7 ft 9 in"  "7 ft 9 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in" 
 [71] "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in" 
 [76] "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in" 
 [81] "7 ft 8 in"  "7 ft 8 in"  "7 ft 8 in"  "7 ft 7 in"  "7 ft 7 in" 
 [86] "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in" 
 [91] "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in" 
 [96] "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 7 in"  "7 ft 6 in" 
[101] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in" 
[106] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in" 
[111] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in" 
[116] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in" 
[121] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in" 
[126] "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 6 in"  "7 ft 5 in" 
[131] "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in" 
[136] "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in" 
[141] "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in"  "7 ft 5 in" 
[146] "7 ft 5 in"  "7 ft 5 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in" 
[151] "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in" 
[156] "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in" 
[161] "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in"  "7 ft 4 in" 
[166] "7 ft 4 in"  "7 ft 4 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[171] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[176] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[181] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[186] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[191] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[196] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[201] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[206] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[211] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in" 
[216] "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"  "7 ft 3 in"

We’ve got numbers with brackets (links to footnotes in the original Wikipedia page), we’ve got some inches measures that look like “1.5 inches”, some that look like “1+1/2 in”, we have some that drop the plus (“81/2 in”, which should probably read “8 1/2 in”), and then we have one observation that seems to have carried over some style code.

First we’ll fix the style code observation by manually overwriting the value using the original table. We’ll also manually fix the observation that lists a height range (“8 ft 0 in-8 ft 1 in”) since for our purposes, there’s not much difference between an 8-foot person and an 8-foot-one person - they’re both very, very tall.

# manual fixes
tall_table_3 <- 
  tall_table_2 %>% 
  mutate(imperial = 
           case_when(name == "Rafael França do Nascimento" ~ "7 ft 8+1⁄3 in", 
                     name == "James Toller" ~ "8 ft 0 in", 
                     TRUE ~ imperial) , 
         imperial = str_trim(imperial, side = "both")
  )

tall_table_3$imperial

  [1] "8 ft 11 in"    "8 ft 9 in"     "8 ft 8 in"     "8 ft 7 in"    
  [5] "8 ft 6 in"     "8 ft 6 in"     "8 ft 6 in"     "8 ft 5 in"    
  [9] "8 ft 5 in"     "8 ft 4 in"     "8 ft 3 in"     "8 ft 3 in"    
 [13] "8 ft 3 in"     "8 ft 3 in"     "8 ft 3 in"     "8 ft 2 in"    
 [17] "8 ft 1 in"     "8 ft 1 in"     "8 ft 1 in"     "8 ft 1 in"    
 [21] "8 ft 1 in"     "8 ft 0 in"     "8 ft 0 in"     "8 ft 0 in"    
 [25] "8 ft 0 in"     "8 ft 0 in"     "8 ft 0 in"     "8 ft 0 in"    
 [29] "8 ft 0 in"     "8 ft 0 in"     "7 ft 11 in"    "7 ft 11 in"   
 [33] "7 ft 11 in"    "7 ft 11 in"    "7 ft 11 in"    "7 ft 11 in"   
 [37] "7 ft 11 in"    "7 ft 10 in"    "7 ft 10 in"    "7 ft 10 in"   
 [41] "7 ft 10 in"    "7 ft 10 in"    "7 ft 10 in"    "7 ft 10 in"   
 [45] "7 ft 10 in"    "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"    
 [49] "7 ft  9 in"    "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"    
 [53] "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"    
 [57] "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"     "7 ft 8+1⁄3 in"
 [61] "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"    
 [65] "7 ft 9 in"     "7 ft 9 in"     "7 ft 9 in"     "7 ft 8 in"    
 [69] "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"    
 [73] "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"    
 [77] "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"    
 [81] "7 ft 8 in"     "7 ft 8 in"     "7 ft 8 in"     "7 ft 7 in"    
 [85] "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"    
 [89] "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"    
 [93] "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"    
 [97] "7 ft 7 in"     "7 ft 7 in"     "7 ft 7 in"     "7 ft 6 in"    
[101] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[105] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[109] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[113] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[117] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[121] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[125] "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"     "7 ft 6 in"    
[129] "7 ft 6 in"     "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"    
[133] "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"    
[137] "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"    
[141] "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"    
[145] "7 ft 5 in"     "7 ft 5 in"     "7 ft 5 in"     "7 ft 4 in"    
[149] "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"    
[153] "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"    
[157] "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"    
[161] "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"    
[165] "7 ft 4 in"     "7 ft 4 in"     "7 ft 4 in"     "7 ft 3 in"    
[169] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[173] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[177] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[181] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[185] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[189] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[193] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[197] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[201] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[205] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[209] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[213] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"    
[217] "7 ft 3 in"     "7 ft 3 in"     "7 ft 3 in"

Next, we’ll remove the un-needed reference numbers in brackets. We can do that manually, too, but it’s not exactly a big-data approach, so let’s use regular expressions (regexps) instead.

The challenge here is that brackets are a special character in regex, so we’ll need to “escape” them (meaning, get R to understand that we mean a literal bracket). The stringr cheat sheet serves as a great summary. You’ll notice that to escape a bracket, you need a double backslash in front of it.

Here’s a demo of how it works:

# demonstrate regexps
tall_table_3 %>% 
  mutate(test = str_extract(imperial, "\\[\\d*\\]")) %>% 
  filter(str_detect(imperial, "\\[\\d*\\]")) %>% 
  select(imperial, test)

# A tibble: 0 × 2
# ℹ 2 variables: imperial , test

tall_table_4 <- 
  tall_table_3 %>% 
  mutate(imperial = str_remove(imperial, "\\[\\d*\\]"))

Next, we need to separate the feet and inches values so we can convert to a value like XX.XX inches, allowing us to do numerical manipulation on the value. The pattern in imperial is now “X ft XX in”, where the inches are expressed in different ways (1/2, 0.5). Let’s do inches first. We want to extract out the number that lies between “ft” and “in”. For this, we can use “look around” regexps, that find a pattern preceding or following another pattern. Roughly speaking:
- “a(?=c)” means “a” followed by “c”
- “(?<=b)a” means “a” preceded by “b”
- Note that “[:graph:]” means any letter, number, or punctuation, and the asterisk after it means repeated zero ore more times.

# demo
tall_table_4 %>% 
  mutate(inches = str_extract(imperial, "(?<=ft)\\s[:graph:]*\\s(?=in)")) %>% 
  select(imperial, inches)

# A tibble: 219 × 2
   imperial   inches
          
 1 8 ft 11 in " 11 "
 2 8 ft 9 in  " 9 " 
 3 8 ft 8 in  " 8 " 
 4 8 ft 7 in  " 7 " 
 5 8 ft 6 in  " 6 " 
 6 8 ft 6 in  " 6 " 
 7 8 ft 6 in  " 6 " 
 8 8 ft 5 in  " 5 " 
 9 8 ft 5 in  " 5 " 
10 8 ft 4 in  " 4 " 
# ℹ 209 more rows

# extract inches value and remove everything from "ft" onward  
tall_table_5 <- 
  tall_table_4 %>% 
  mutate(inches = str_extract(imperial, "(?<=ft)\\s[:graph:]*\\s(?=in)"),
         imperial = str_remove(imperial, "\\s(ft)\\s[:graph:]*\\s[:graph:]*")) %>% 
  rename(ht_ft = imperial)

# trim white-space
tall_table_6 <- 
  tall_table_5 %>% 
  mutate(inches = str_trim(inches, side = c("both")), 
         ht_ft = str_trim(ht_ft, side = c("both")))

Now, we get to the most challenging part: transforming inches into a numerical variable. This means converting numbers written as fractions into decimals, while not transforming the already-clean decimal values. The simplest way to do this is probably to find a forward-slash (/), and find the numbers immediately before and after it. After that, we’ll separate out the numbers and divide them to arrive at a final, numerical inches_decimal.

# clean inches variable
tall_table_7 <- 
  tall_table_6 %>% 
  mutate(inches_fraction = str_extract(inches, "\\d\\⁄\\d"), 
         inches = str_remove(inches, "\\d\\⁄\\d"), 
         inches = str_remove(inches, "\\+"), 
         inches = str_trim(inches, side = c("both"))) %>% 
  mutate(inches_1 = as.numeric(str_sub(inches_fraction, 1, 1)), 
         inches_2 = as.numeric(str_sub(inches_fraction, -1, -1)), 
         inches_decimal = round((inches_1/inches_2), digits = 2))

# demo
tall_table_7 %>% 
  filter(!is.na(inches_decimal)) %>% 
  select(inches, inches_fraction, inches_1, inches_2, inches_decimal)

# A tibble: 1 × 5
  inches inches_fraction inches_1 inches_2 inches_decimal
                                
1 8      1⁄3                    1        3           0.33

Finally, we will add inches to inches_decimal to arrive at the final portion of height in inches. We’ll also address the outlier “7¼” inches. Then, we’ll convert the now-clean inches to feet, and add it to ht_ft.

tall_table_8 <- 
  tall_table_7 %>% 
  mutate(inches = if_else(inches == "7¼", "7.25", inches), 
         inches = as.numeric(inches), 
         inches = if_else(is.na(inches), 0, inches), 
         in_to_feet = round((inches/12), digits = 2), 
         ht_ft = if_else(name ==  "Jeison Rodríguez", "7.44", ht_ft),
         ht_ft = round(as.numeric(ht_ft), digits = 2), 
         ht_ft = ht_ft + in_to_feet
  ) %>% 
  select(-c(inches_fraction, inches, inches_1, inches_2, inches_decimal, in_to_feet))

Now we can do a fun exercise - we can check our work by directly converting ht_cm to height in feet (one foot is 30.48 cm), and seeing if all the wrangling we underwent with inches and feet gave us correct numbers.

# test whether calculated value matches string extract
test <-
  tall_table_8 %>% 
  select(ht_ft, ht_cm) %>% 
  mutate(check_ht = round(ht_ft*30.48, digits = 2))

test

# A tibble: 219 × 3
   ht_ft ht_cm check_ht
        
 1  8.92   272     272.
 2  8.75   267     267.
 3  8.67   264     264.
 4  8.58   262     262.
 5  8.5    259     259.
 6  8.5    258     259.
 7  8.5    258     259.
 8  8.42   257     257.
 9  8.42   257     257.
10  8.33   254     254.
# ℹ 209 more rows

We’re not dead on, but we got pretty close. The reason for the error has a lot more to do with rounding in the original table than our text-parsing. And after all that work, our data-frame is tidy-ish.

2. The `lifespan_age_at_death` Variable

This is what the lifespan_age_at_death column looks like now:

tall_table_8 %>% 
  select(lifespan_age_at_death)

# A tibble: 219 × 1
   lifespan_age_at_death
                   
 1 1918–1940 (22)       
 2 1867–1905 (38)       
 3 1932–1969 (37)       
 4 1924–1943 (18)       
 5 1913–1948 (24–25)    
 6 1600–1649 (48–49)    
 7 1924/25–1944(19–20)  
 8 1984–2019 (34)       
 9 1989–2015 (26)       
10 1897–1921 (23)       
# ℹ 209 more rows

We want the year of birth, year of death, and age at death to be their own variables. Scanning the values, there are several different scenarios:
1. Birth year - death year (YYYY-YYYY) followed by (age or age range)
2. Range for birth year and death year (YYYY/YY - YYYY/YY)
3. “born” followed by a year of birth (YYYY) and no death year
4. Some text followed by “?” followed by a year
5. Year of birth
6. “born” followed by a range and some text
7. Some entries contain a reference number in brackets

First we’ll remove brackets and anything between them, addressing scenario 7. Then we’ll populate an age_at_death variable by extracting anything in parentheses.

# define regular expression for any string between parentheses, not including a parenthesis
regex_bet_paren <- "\\([^)]+\\)"

tall_table_9 <- 
  tall_table_8 %>% 
  mutate(lifespan_age_at_death = str_remove_all(lifespan_age_at_death, "\\[\\d*\\]"), 
         age_at_death = str_extract(lifespan_age_at_death, regex_bet_paren), 
         lifespan_age_at_death = str_remove_all(lifespan_age_at_death, regex_bet_paren),
         age_at_death = str_remove_all(age_at_death, "\\(|\\)"),  
         lifespan_age_at_death = str_trim(lifespan_age_at_death, side = "both"),
         age_at_death = str_trim(age_at_death, side = "both"), 
         age_at_death = if_else(age_at_death == "aged 24 as of March 2022", "", age_at_death)
  )

Next we separate birth year and death year by the hyphen delimiter. Note the regexp meanings:
- \\d* means any quantity of consecutive digits
- (?=–) means something followed by a hyphen
- (?<=–) means something following a hyphen

tall_table_10 <- 
  tall_table_9 %>% 
  mutate(birth_year = str_extract(lifespan_age_at_death, "\\d*(?=–)"), 
         death_year = str_extract(lifespan_age_at_death, "(?<=–)\\d*"))

tall_table_10

# A tibble: 219 × 9
   name  country ht_cm ht_ft note  lifespan_age_at_death age_at_death birth_year
                                        
 1 Robe… United…   272  8.92 Tall… 1918–1940             22           1918      
 2 John… United…   267  8.75 Seco… 1867–1905             38           1867      
 3 John… United…   264  8.67 8 ft… 1932–1969             37           1932      
 4 Will… United…   262  8.58 Thou… 1924–1943             18           1924      
 5 Siah… Iran      259  8.5  Suff… 1913–1948             24–25        1913      
 6 Akas… Japan     258  8.5  Tall… 1600–1649             48–49        1600      
 7 Mala… Malawi    258  8.5  Not … 1924/25–1944          19–20        25        
 8 Hồ V… Vietnam   257  8.42 He w… 1984–2019             34           1984      
 9 Porn… Thaila…   257  8.42 Not … 1989–2015             26           1989      
10 Bern… United…   254  8.33 Coyn… 1897–1921             23           1897      
# ℹ 209 more rows
# ℹ 1 more variable: death_year

Next we’ll address scenario 3: “born” followed by a year of birth (YYYY) and no death year. We’ll also make some manual fixes for a few observtions that don’t translate using our rules.

# populate birth year using a number preceded by "born"
tall_table_11 <- 
  tall_table_10 %>% 
  mutate(birth_year = if_else(is.na(birth_year), str_extract(lifespan_age_at_death, "(?<=born )\\d*"), birth_year))

# manual fixes
tall_table_12 <- 
  tall_table_11 %>% 
  mutate(birth_year = case_when(lifespan_age_at_death == "1958-1992" ~ "1958",
                                lifespan_age_at_death == "c. born 1995" ~ "1995",
                                lifespan_age_at_death == "1844-1899" ~"1844", 
                                lifespan_age_at_death == "1946-1993" ~"1946",
                                lifespan_age_at_death == "1880/85 – 1925/30" ~ "1880",
                                TRUE ~ birth_year), 
         death_year = case_when(lifespan_age_at_death == "1958-1992" ~ "1992", 
                                lifespan_age_at_death == "fl.?-March 2019" ~ "2019", 
                                lifespan_age_at_death == "1844-1899" ~ "1899",
                                lifespan_age_at_death == "1946-1993" ~ "1993", 
                                lifespan_age_at_death == "1880/85 – 1925/30" ~ "1925", TRUE ~ death_year)) %>% 
  mutate(birth_year = as.numeric(birth_year), 
         death_year = as.numeric(death_year)) %>% 
  filter(!lifespan_age_at_death == "173–238")


# check
tall_table_12 %>% 
  select(lifespan_age_at_death, birth_year, death_year) %>% 
  filter(is.na(birth_year) | is.na(death_year))

# A tibble: 125 × 3
   lifespan_age_at_death birth_year death_year
                               
 1 born 1982                   1982         NA
 2 born 1982                   1982         NA
 3 born 1987                   1987         NA
 4 born 1983                   1983         NA
 5 1835–?                      1835         NA
 6 born 1999                   1999         NA
 7 born 1966                   1966         NA
 8 born 1999                   1999         NA
 9 born 1988                   1988         NA
10 born 1986                   1986         NA
# ℹ 115 more rows

3. The `note` Variable

Finally, we’ll clean up note by removing anything between brackets.

# clean note variable
tall_table_13 <- 
  tall_table_12 %>% 
  mutate(note = str_remove_all(note, "\\[\\d*\\]"))

tall_table_13

# A tibble: 219 × 9
   name  country ht_cm ht_ft note  lifespan_age_at_death age_at_death birth_year
                                        
 1 Robe… United…   272  8.92 Tall… 1918–1940             22                 1918
 2 John… United…   267  8.75 Seco… 1867–1905             38                 1867
 3 John… United…   264  8.67 8 ft… 1932–1969             37                 1932
 4 Will… United…   262  8.58 Thou… 1924–1943             18                 1924
 5 Siah… Iran      259  8.5  Suff… 1913–1948             24–25              1913
 6 Akas… Japan     258  8.5  Tall… 1600–1649             48–49              1600
 7 Mala… Malawi    258  8.5  Not … 1924/25–1944          19–20                25
 8 Hồ V… Vietnam   257  8.42 He w… 1984–2019             34                 1984
 9 Porn… Thaila…   257  8.42 Not … 1989–2015             26                 1989
10 Bern… United…   254  8.33 Coyn… 1897–1921             23                 1897
# ℹ 209 more rows
# ℹ 1 more variable: death_year

Conclusion

That’s more or less all there is to it. If you’re working with big data, it’ll be a lot more challenging to account for all the patterns. But this example gives us an entry point to regular expressions and using them within the context of stringr.

You can also learn a lot more about working with strings here: Handling Strings with R.

Mapping Air Pollution with leaflet

Alice Tivarovsky — Thu, 25 Aug 2022 00:00:00 GMT

Motivation

These days, it seems like there is an ever-growing list of massive, complicated issues to worry about - between climate change, nuclear war, mega-droughts, wildfires. Reading the news feels like an exercise in adding to that list.

But sometimes, the news gives us a bright spot. My home state of California - a place, which was once home to some of the worst air pollution in the world, recently passed a resolution to eliminate gasoline-powered cars by 2035. I was modestly excited by this, but I was more interested in the current air pollution situation. Since I don’t think about air pollution all that much, I ended up in a rabbit-hole of unstructured research. How bad is air pollution now? How does my state, city, and county compare to others in the US? Is air pollution getting better or worse?

I will attempt to answer some of those questions below. Of course, others have already done that, and probably in a more compelling manner. But I learned a lot going through the process myself, and if you want to learn a bit about geospatial data andleaflet, I think an exercise like this is highly useful. For a thorough tutorial on the capabilities of leaflet in R, please refer to the official tutorial here.

Background

Globally, over 6 million people die each year as a result of air pollution. It’s not something we think much about in the United States or other parts of the developed world (aside from, maybe, complaining about the smog in Los Angeles), but it’s a leading cause of death in parts of Africa and Asia. And unfortunately, it seems to be getting worse in other parts of the world.

Although progress has been made through better policy and environmental regulation, this magnitude of premature deaths should surely attract more attention than it does now. Some have posed plausible reasons for the public’s lack of interest (mainly that it’s an “over there” problem). Others have scolded countries for not doing more to protect public health. Either way, the health effects of air pollution require more research and attention.

Data Preparation

library(tidyverse)
library(readxl)
library(leaflet)
library(stats)
library(sf)
library(RColorBrewer)

In the United States, the EPA maintains tens of thousands of outdoor air quality monitors and provides data to the public through several sources, including the AirData website. First, we’ll practice mapping skills by pinning all these monitors on a map. The geo-locations for all active monitors were downloaded here. We read in the data, call leaflet, add tiles, and center on a point in the middle of the country.

sites <- read.csv("data/aqs_sites 3.csv", header = TRUE)

# Choose coordinates in middle of country
naked_map <- 
  leaflet() %>% 
  setView(lng = -95, lat = 40, zoom = 4)  %>% 
  addTiles() 

naked_map

It never fails to amaze me how little code it takes to make a map. Next, we’ll pass the sites object (EPA refers to the location monitors as sites) to leaflet and visualize them as markers on the map.

sites_map <- 
  leaflet(sites) %>% 
  setView(lng = -95, lat = 40, zoom = 4)  %>% 
  addTiles() %>% 
  addCircleMarkers(lat = ~Latitude, 
                   lng = ~Longitude, 
                   radius = 1)

sites_map

Most states look like blue blobs, but we can zoom in and find the ones in our neighborhood (unless, of course, we live in the middle of Nevada).

Analysis

Now let’s get a sense of what those monitors are measuring.

As someone not well-versed in environmental pollutants, figuring out what dataset and which measures to use was a bit complicated. Two common measures are PM 2.5 (particulate matter 2.5 micrometers or smaller in diameter) and ground level ozone.

But a more general metric, one which combines these and other toxic pollutants, is the Air Quality Index (AQI). Even if you’re not terribly concerned about air pollution, you’ve probably seen AQI measures before, possibly through your weather app telling you the air quality is bad so close your windows and don’t even think about leaving your house. Or perhaps you’ve seen a local alert or warning to that effect. ¹

Given its ubiquity, and the fact that it’s a more general metric than PM 2.5, ground level ozone, or any other specific particulate, I decided to look at AQI. More specifically, we’ll be looking at annual median AQI by county. State-level measures are too large for air pollution data, and city level is likely too small. I’ll be comparing 2021 data to 2013 (the years were chosen arbitrarily). We’ll load the data and look at a snapshot.

# annual 'concentration by monitor' dataset for 2013
full_2013 <- 
  read.csv("data/annual_aqi_by_county_2013.csv", header = TRUE) %>% 
  janitor::clean_names()

head(full_2013)

    state  county year days_with_aqi good_days moderate_days
1 Alabama Baldwin 2013           273       235            38
2 Alabama    Clay 2013           118       100            18
3 Alabama Colbert 2013           285       252            33
4 Alabama  DeKalb 2013           360       319            41
5 Alabama  Elmore 2013           244       229            15
6 Alabama  Etowah 2013           281       244            37
  unhealthy_for_sensitive_groups_days unhealthy_days very_unhealthy_days
1                                   0              0                   0
2                                   0              0                   0
3                                   0              0                   0
4                                   0              0                   0
5                                   0              0                   0
6                                   0              0                   0
  hazardous_days max_aqi x90th_percentile_aqi median_aqi days_co days_no2
1              0      87                   54         36       0        0
2              0      65                   52         32       0        0
3              0      80                   51         38       0        0
4              0      93                   52         38       0        0
5              0      87                   48         36       0        0
6              0      90                   52         37       0        0
  days_ozone days_pm2_5 days_pm10
1        200         73         0
2          0        118         0
3        202         83         0
4        305         55         0
5        244          0         0
6        197         84         0

# annual 'concentration by monitor' dataset for 2021
full_2021 <- 
  read.csv("data/annual_aqi_by_county_2021.csv", header = TRUE) %>% 
  janitor::clean_names() 

head(full_2021)

    state    county year days_with_aqi good_days moderate_days
1 Alabama   Baldwin 2021           280       264            16
2 Alabama      Clay 2021           110       101             9
3 Alabama    DeKalb 2021           361       331            30
4 Alabama    Elmore 2021           241       238             3
5 Alabama    Etowah 2021           286       253            33
6 Alabama Jefferson 2021           365       174           186
  unhealthy_for_sensitive_groups_days unhealthy_days very_unhealthy_days
1                                   0              0                   0
2                                   0              0                   0
3                                   0              0                   0
4                                   0              0                   0
5                                   0              0                   0
6                                   3              2                   0
  hazardous_days max_aqi x90th_percentile_aqi median_aqi days_co days_no2
1              0      61                   48         35       0        0
2              0      67                   47         27       0        0
3              0      84                   49         36       0        0
4              0      87                   44         32       0        0
5              0      77                   51         36       0        0
6              0     179                   77         51       0        1
  days_ozone days_pm2_5 days_pm10
1        221         59         0
2          0        110         0
3        320         41         0
4        241          0         0
5        213         73         0
6         83        280         1

Now we need to figure out how to present the AQI data visually - one way might be to color the marker representing each monitor in accordance with the level of pollution it measured for some time interval. But given the high concentration of dots, it might be hard to read. Instead, let’s try to divide the United States by county lines. The intent of this approach is to mimic what the Washington Post used in this 2019 article, where it reported an excess of 10,000 deaths due to air pollution over a 2-year period.

To do this, we’ll need county shapefiles- geo-spatial boundary files that will trace the shape of each county - which will comprise a layer over our bare leaflet map. The Census Bureau maintains shapefiles in accordance with current county boundaries, and the ones used below were found here.

Reading these shapefiles into R requires the rgdal package and readOGR function.

# Source for shapefiles: https://www.census.gov/geographies/mapping-files/time-series/geo/carto-boundary-file.html
counties <- 
  st_read("cb_2018_us_county_5m", layer = "cb_2018_us_county_5m") %>% 
  st_transform(4326)

Reading layer `cb_2018_us_county_5m' from data source 
  `/Users/alicetivarovsky/my_website_quarto/posts/leaflet-pollution/cb_2018_us_county_5m' 
  using driver `ESRI Shapefile'
Simple feature collection with 3233 features and 9 fields
Geometry type: MULTIPOLYGON
Dimension:     XY
Bounding box:  xmin: -179.1473 ymin: -14.55255 xmax: 179.7785 ymax: 71.35256
Geodetic CRS:  NAD83

counties_map <- 
  leaflet(counties) %>% 
  setView(lng = -95, lat = 40, zoom = 4)  %>% 
  addTiles() %>% 
  addPolygons(weight = 0.1, smoothFactor = 0.5,  opacity = 1.0, fillOpacity = 0.2)

counties_map

The shapefiles are working as expected - we can see well-defined state and county borders, overlaid nicely on top of the map. But what we want is a map, like the one above, but color-coded according to the value of the selected parameter - in our case, the median annual AQI. In map-speak, this is called a chloropleth, and in order to make one, we need to give leaflet the following things: - A color palette - A numeric vector defining “bins” (i.e cutoff points at which one color in the palette will change to the next)

Since we don’t yet know the range of values for median AQI, let’s run some descriptive statistics on it.

# 2013 data
range(full_2013$median_aqi)

[1]  4 89

quantile(full_2013$median_aqi)

  0%  25%  50%  75% 100% 
   4   34   38   43   89

# 2021 data
range(full_2021$median_aqi)

[1]   3 122

quantile(full_2021$median_aqi)

  0%  25%  50%  75% 100% 
   3   33   37   41  122

Without any calculations or data visualization, we can already see that the 2021 maximum is much higher than 2013. But let’s press on, now that we have a general sense of the spread of AQI. Note that the color palette was chosen arbitrarily from RColorBrewer.

# 2013
bins_13 <- c(0, 20, 40, 60, 80, 100, 120, 140)
pal_13 <- colorBin("Reds", domain = full_2013$median_aqi, bins = bins_13)

# 2021
bins_21 <-  c(0, 20, 40, 60, 80, 100, 120, 140)
pal_21 <- colorBin("Reds", domain = full_2021$median_aqi, bins = bins_21)

And now, we get to the somewhat tricky part of the process. We need to combine the shapefile object counties with the 2013 and 2021 air pollution datasets stored in full_2013 and full_2021. This seems impossible since we’re combining a geospatial object with a standard dataset, but it turns out to be pretty simple with the merge function in the sp package:

# 2013 merge
full_2013_1 <- 
  full_2013 %>% 
  select(county, median_aqi) %>% 
  rename("NAME" = county)

counties_13 <- merge(counties, full_2013_1, by = "NAME", all.x = TRUE)

# 2021 merge
full_2021_1 <- 
  full_2021 %>% 
  select(county, median_aqi) %>% 
  rename("NAME" = county) 

counties_21 <- merge(counties, full_2021_1, by = "NAME", all.x = TRUE)

Finally, we’re ready to map the data. Notice that we’re using a smaller value in the weight argument of addPolygons than we did above. This is to make the boundaries seamless and minimize visual clutter now that the counties are presented with different colors. We are also using a pop-up label, so that the user can see the name of the county corresponding to the polygon.

map_2013 <- 
  leaflet(counties_13) %>% 
  setView(lng = -95, lat = 40, zoom = 4)  %>% 
  addTiles() %>% 
  addPolygons(weight = 0.05, fillOpacity = 0.8, fillColor = ~pal_13(counties_13$median_aqi), popup = ~paste(counties_13$NAME, "
", "Median Annual AQI:", counties_13$median_aqi))

map_2013

map_2021 <- 
  leaflet(counties_21) %>% 
  setView(lng = -95, lat = 40, zoom = 4)  %>% 
  addTiles() %>% 
  addPolygons(weight = 0.01, fillOpacity = 0.8, fillColor = ~pal_21(counties_21$median_aqi), popup = ~paste(counties_21$NAME, "
", "Median Annual AQI:", counties_21$median_aqi))

map_2021

There’s definitely quite a bit more red on the 2021 map. How much more is hard to quantify just eyeballing, so we’d want a good statistical test if we were to go any further. What is useful, though, is in-map comparison across counties.

Conclusion

I hope this walk-through inspired you to play with leaflet on your own. I said it before, but I never cease to be amazed by the capabilities of interactive packages in R, and leaflet is as nice as they get. Please don’t hesitate to contact me if you have any questions or suggestions. Happy mapping!

References

https://sesync-ci.github.io/maps-in-R-lesson/2016/09/14/#/slides/shinyleaflet
https://aqs.epa.gov/aqsweb/airdata/download_files.html#Annual (Air Quality datasets); used Annual Concentration by Monitor

Footnotes

Here in Los Angeles, we see them frequently during fire season.↩︎

Alice Tivarovsky

Useful Resources

Data Science, Programming & R

Statistics

Blogging & Hugo

Statistics Concept Map

Motivation

Concept Map

Adding Subset Buttons to plot_ly Plots

Motivation

Data Preparation

Analysis

Conclusion

Cleaning Messy Strings Using stringr and Regular Expressions

Motivation

Import

Tidy

1. The metric Variable

2. The lifespan_age_at_death Variable

3. The note Variable

Conclusion

Mapping Air Pollution with leaflet

Motivation

Background

Data Preparation

Analysis

Conclusion

References

Footnotes

1. The `metric` Variable

2. The `lifespan_age_at_death` Variable

3. The `note` Variable