The Digital Divide in the U.S.

January 17, 2018

With the release of the American Community Survey, there was an opportunity to take a look at the digital divide in 2016.

I was inspired to make a tilegram map similar to those create by NPR. I used the tilegramsR package by Bhaskar Karambelkar.

First, here are the packages for the job.

#Data clean up

#Obtaining Census data

#Needed to create tilegram map

Census Data

I obtained state level data from the 1 year American Community Survey from 2016:

stateNoInt = get_acs(geography = "state", variables = c("B28002_013E", "B28002_001E"), survey = "acs1")
#B28002_013E --> No Internet Access
#B28002_001E --> Total population

I tidy-ed the data so that each row represented one state. I also created the percent column. stateNoInt %>% select(-moe) %>%  spread(variable, estimate) %>% 
  mutate(percent = (B28002_013/ B28002_001)*100)

The census data uses full state names, while the map data uses state abbreviations. To join the dataframes, I had to match the full state names to the state abbreviations:

for (i in 1:nrow( {
  x =$NAME[i]$state[i] =[match(x,]

A few corrections (sorry, Puerto Rico):$state[9] = "DC" =[-52,]

Making the Map

The simple features(sf) maps are provided by the tilegramR package:

baseMap = sf_NPR1to1
baseMap.centers = sf_NPR1to1.centers

Joining the census data with the maps data: = right_join(baseMap,, by="state") = right_join(baseMap.centers,, by="state")

This part of the code comes from Rpubs by Bhaskar Karambelkar:

getLeafletOptions <- function(minZoom, maxZoom, ...) {
    crs = leafletCRS("L.CRS.Simple"),
    minZoom = minZoom, maxZoom = maxZoom,
    dragging = FALSE, zoomControl = FALSE,
    tap = FALSE,
    attributionControl = FALSE , ...)

I created the bins for the data prior to mapping. The rest of the code is adapted from Rpubs and it creates the final map:

int.pal = colorBin("plasma", round($percent), pretty=FALSE, 5)

tileGramMap = leaflet(,
  options= getLeafletOptions(-1, -1)) %>%
    weight=2,color='#000000', group = 'state',
    fillOpacity = 0.6, opacity = 1, fillColor= ~int.pal(percent),
    highlightOptions = highlightOptions(weight = 4), 
    popup = as.character(round($percent, 1))) %>%
    label = ~as.character(state),
    labelOptions = labelOptions(
      noHide = 'T', textOnly = T,
      offset=c(-4,-10), textsize = '12px')) %>%
  addLegend(pal = int.pal, values = ~percent, opacity = 0.7, position = "bottomright",  
            labFormat = labelFormat(suffix  = "%"), title="Percent of Households Without Internet") %>%