Tidy Tuesday: Geomapping Beer Awards with Leaflet

Every week R4DS publishes a dataset on Tuesday for the community to promote learning and knowledge sharing. This week’s dataset is beers that have earned medals at the Great American Beer Festival from 1987 to 2020.

library(tidytuesdayR) #get data 
tuesdata <- tidytuesdayR::tt_load(2020, week = 43)
beer_awards <- tuesdata$beer_awards

The notes for this file indicate that the data is not complete which doesn’t make it a great candidate for a modeling project. However, after poking around a little it looks like it’s a good match for making an interactive map. It could be useful to know where to get an award winning beer on a road trip.

I am going to use Leaflet, a javascript library that renders client-side to get interactivity without the need to host my visualization on a server.

In order to be able to use Leaflet, we will need to geocode the cities from the data. I’m using ggmap for this task.

library(tidyverse) #the tidyverse, duh
library(leaflet) #for making an interactive map
library(ggmap) #for geoencoding, requires Google API registration
library(glue) #for creating labels for the location markers
library(crayon) #for bolding elements of labels
library(htmltools) #so label reads as html tag

Let’s only use the 2020 data to make things a little easier.

beer_2020 <- beer_awards %>% filter(year == 2020)

I want people to be able to see the name of the brewery and which beers won which awards. Leaflet builds marker labels in HTML, for a single point so I am going to have to do some manipulation to get the readout to look correct.

I am using crayon to bold the name of the brewery and HTML tags to color the name of the beer by the type of medal it received.

#create html tags for the labels
gold_text <- '<p style="color:#d4af37;">'
silver_text <- '<p style="color:#aaa9ad;">'
bronze_text <- '<p style="color:#cd7f32;">'

labeled_beer_2020 <- 
  beer_2020 %>% 
  mutate(beer_label = case_when(
    medal == "Gold" ~ glue("{gold_text} {beer_name} ({category})</p>"),
    medal == "Silver" ~ glue("{silver_text} {beer_name} ({category})</p>"),
    medal == "Bronze" ~ glue("{bronze_text} {beer_name} ({category})</p>")
  ), brewery_label = glue('<b>{brewery}</b>')) %>% 
  group_by(brewery) %>% 
  #wrap the label in HTML() so that leaflet knows to read it as HTML
  summarise(label = HTML(first(glue("{brewery_label}: {glue_collapse(beer_label, sep ='\n',last = '')}"))), 
            city = first(city), 
            state = first(state)) %>% 
            distinct(label, .keep_all = TRUE)

Let’s use geocode to grab the latitude and longitude of the city of each award winning brewery and we are ready to go!

lat_long <- 
  labeled_beer_2020 %>% 
  #combine city and state for an address google can use
  mutate(geo_city = paste(city, state, sep = ", ")) %>% 
  #grab the lat and long from the api and add to the dataframe
  mutate_geocode(geo_city)

And with a couple of lines of code, we have an interactive map that shows breweries that won awards at the Great American Beer Festival in 2020!

beer_map <-
  #intialize leaflet app
  leaflet(lat_long) %>% 
    #add initial map from CartoDB
    addProviderTiles(providers$CartoDB.Positron) %>%
    #add markers that cluster at higher levels
    addMarkers(clusterOptions = markerClusterOptions(), label = ~label) %>%   #set starting view
    setView(-93.65, 42.0285, zoom = 4)

Nota Bene: This site is rendered in Hugo, so in order to get the leaflet html widget to display, I saved it and embedded it in an iframe.