Could You Reasonably Drive to a Gold Medal-Winning Brewery right now?

By Ian Bell • Twitter: Ian_Bellio • October 2020

Below is a map of all the American breweries that have won a Gold Medal for one of their beers from the Great American Beer Festival. I have added a blue 50-mile buffer, which is what I figure to be a reasonable distance to drive for some delicious beer once in a while. Your mileage may vary.

Click on each city below to find the local breweries that have won a gold. Locations are approximate based on the listed home city of each brewery.

Click here for map R code

library(tidyverse)
library(leaflet)
library(sf)

#DATA
beer_awards <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-10-20/beer_awards.csv')

us_cities_states_counties <- read_csv('https://raw.githubusercontent.com/kelvins/US-Cities-Database/main/csv/us_cities.csv')

#TIDY

locations <- inner_join(beer_awards, us_cities_states_counties, by = c("state" = "STATE_CODE" , "city" = "CITY")) %>%
  distinct(medal, beer_name, brewery, city, state, .keep_all = TRUE) %>%
  filter(medal == "Gold") %>%
  group_by(LATITUDE, LONGITUDE) %>%
  mutate(all_pubs = paste(unique(brewery), collapse = ", "))

cities <- st_as_sf(locations, coords=c("LONGITUDE", "LATITUDE"), crs = 4326) %>%
  st_transform(crs = 7801)

buffer_50mi <- st_buffer(cities, 80467) %>%
  st_union() %>%
  st_cast("POLYGON") %>%
  st_transform(crs = 4326)

#PLOT

map <- leaflet(width = "100%") %>%
  addMeasure(primaryLengthUnit = "meters") %>%
  addTiles() %>%
  addPolygons(data = buffer_50mi) %>%
  addCircleMarkers(data = locations, ~LONGITUDE, ~LATITUDE, fillOpacity = 0.5, radius=2, color = "purple",
                   popup=~paste("<strong>City:</strong>", city, state,
                                "<br>",
                                "<strong>Gold Medal Brewery:</strong>",all_pubs))

---

Data table

Below is a table of every gold, silver, and bronze medal-winning beer from the Festival.

Click here for table R code

library(DT)
library(htmlwidgets)

beer_awards <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2020/2020-10-20/beer_awards.csv')

table <- datatable(beer_awards, extensions = c("Buttons" , "FixedColumns"),
           filter = 'top',
           options = list( autoWidth = TRUE , 
                           dom = 'Blftip',
                           pageLength = 20,
                           searchHighlight = FALSE,
                           buttons = c('copy', 'csv', 'print'),
                           scrollX = TRUE,
                           fixedColumns = list(leftColumns = 2)),
           class = c('compact cell-border stripe hover') ,
           rownames = FALSE)
table

---

This project’s data comes from the Great American Beer Festival. This map is a weekly contribution to the TidyTuesday weekly data project in R to practice R coding skills.