Leaflet app in R to explore U.S. Census demographics by county

leaflet-county-explorer.r

# TODO: Add a Shiny dropdown to select demographic variable
library(leaflet)
library(noncensus)
library(dplyr)

data("counties", package="noncensus")
data("county_polygons", package="noncensus")
data("quick_facts", package="noncensus")

counties <- counties %>%
  filter(!state %in% c('AK', 'HI')) %>%
  mutate(fips=as.integer(paste0(state_fips, county_fips)))

quick_facts <- quick_facts %>%
  filter(fips != 0) %>%
  inner_join(., counties, by="fips")

fips_intersection <- intersect(unique(quick_facts$fips),
                               unique(county_polygons$fips))

county_polygons <- county_polygons %>%
  filter(fips %in% fips_intersection) %>%
  arrange(fips)

quick_facts <- quick_facts %>%
  filter(fips %in% fips_intersection)

# Replicate a county's quick facts data based on its number of polygons
num_polygons <- county_polygons %>%
  group_by(fips) %>%
  summarize(polygons=sum(is.na(lat))) %>%
  mutate(polygons=ifelse(polygons < 1, 1, polygons)) %>%
  arrange(fips)

fips_replicates <- with(num_polygons, rep(fips, polygons))
fips_replicates <- data_frame(fips=fips_replicates)
quick_facts <- inner_join(quick_facts, fips_replicates)

# Color Palette
pal <- colorQuantile("BrBG", NULL, n=10)

county_popup <- paste0("<strong>County: </strong>",
                       quick_facts$county_name,
                       "<br />",
                       "<strong>2013 Population: </strong>",
                       quick_facts$population_2013)

leaflet(data=county_polygons) %>%
  addTiles('http://a.tiles.mapbox.com/v3/kwalkertcu.l1fc0hab/{z}/{x}/{y}.png') %>%
  setView(lat=38, lng=-96, zoom=4) %>%
  addPolygons(lat=~lat, lng=~long, fillColor=~pal(quick_facts$population_2013),
              opacity=1, fillOpacity=0.8,
              stroke=TRUE, color="black", weight=1,
              popup=county_popup)