The purpose of this map is to illustrate Bexar County Fall 2018 early voting turnout by location and median household income accross the county using data from Bexar County and the US Census Bureau. For this project, voting results are from October 22 to November 2 2018 in Bexar County, and the Census information is from 2016.
The data on early voting turnout across all 43 locations was manually scrapped from Bexar County and pasted into excel. This data was very useful, however, there were no coordinates or address. After some googling, a list of addresses appeared, which I copied into the excel table(bev), and into https://www.gps-coordinates.net/. The website gave me the coordinates and zip code for each address, which I also pasted onto bev.
All the parts bev into one
EarlyVotingLocations <-c("Bexar County Elections","Bexar County Justice Center","Brookhollow Library","Castle Hills City Hall","Claude Black Center","Cody Library","Converse City Hall","Copernicus Community Center","East Central ISD Admin","Encino Branch Library","Fair Oaks Ranch City Hall","Great Northwest Library","Henry A Guerra Jr. Library","John Igo Library","Johnston Library","Julia Yates Semmes Library","Las Palmas Library","Leon Valley Conference Center","Lion's Field","Maury Maverick Library","McCreless Library","Memorial Library","Mission Library","Northside Activity Center","Northwest Vista College","Olmos Park City Hall","Palo Alto College","Parman Library @ Stone Oak","Precinct 1 Satellite Office","San Antonio College ECO Centro","Schaefer Library","Shavano Park City Hall","Somerset ISD Admin","South Park Mall","South San Admin Building","Southside ISD Administration Building","Southwest Admin Bldg","Thousand Oaks/El Sendero Library","Tobin Library @ Oakwell","Universal City Library","University of Texas at San Antonio","Windcrest Takas Park","Wonderland of the Americas@Crossroads")
TotalEarlyVotes<-c(7391,5341,19544,9331,4965,14679,8545,3654,3765,14454,8925,16793,7668,17752,6547,15161,7666,10414,9435,14706,8589,7060,6441,8121,11901,6920,3138,16251,4044,6252,3304,11900,1466,7369,1706,2206,1836,7904,14049,8815,10575,7161,16635)
lat <-c(29.4150341,29.4236802,29.5695498,29.5219878,29.4199184,29.5471249,29.5148724,29.4143321,29.362738,29.636783,29.7301896,29.4834128,29.424587,29.5696193,29.3718331,29.5792279,29.4180843,29.5008721,29.453726,29.524715,29.3815691,29.4482537,29.365167,29.4500972,29.4721536,29.4718481,29.322851,29.6344342,29.3441669,29.4462018,29.393107,29.5850634,29.2280421,29.3548173,29.3547808,29.2368189,29.3087035,29.54509,29.5105866,29.5495251,29.5844504,29.5245588,29.4928558)
streetaddress <- c("1103 S Frio S","300 Dolorosa","530 Heimer Road","209 Lemonwood Dr","2805 East Commerce","11441 Vance Jackson","405 S. Seguin Rd","5003 Lord Rd.","6634 New Sulphur Springs Road","2515 East Evans Rd","7286 Dietz Elkhorn","9050 Wellwood","7978 W Military Drive","13330 Kyle Seale Parkway","6307 Sun Valley Drive","15060 Judson Road","515 Castroville Road","6421 Evers Rd","2809 Broadway","8700 Mystic Park","1023 Ada Street","3222 Culebra","3134 Roosevelt Ave","7001 Culebra","3535 N. Ellison Dr","120 W El Prado ","1400 W. Villaret Blvd","20735 Wilderness Oak","3505 Pleasanton Rd","1802 N. Main","6322 US Hwy 87 E","900 Saddletree Ct","7791 E. 6th, Somerset","2310 S.W. Military","5622 Ray Ellison","1460 MartinezLosoya","11914 Dragon Lane","4618 Thousand Oaks","4134 Harry Wurzbach","100 Northview Dr.","1 UTSA Circle","9310 Jim Seal Dr","4522 Fredericksburg")
zip <- c(78207,78205,78232,78213,78202,78230,78109,78220,78263,78259,78015,78250,78227,78249,78227,78247,78237,78240,78209,78254,78223,78228,78214,78238,78251,78212,78224,78260,78221,78212,78222,78231,78069,78224,78242,78221,78252,78233,78209,78148,78249,78233,78201)
lng <- -(c(98.5062865,98.4942366,98.4731861,98.5214266,98.4469777,98.565363,98.3122738,98.3937907,98.359966,98.4492657,98.6257747,98.6629378,98.6254735,98.6432035,98.6395634,98.3725597,98.5494417,98.6132545,98.4729503,98.6418834,98.4579271,98.5642472,98.480088,98.6239381,98.7067569,98.4903431,98.5466543,98.5145754,98.5050857,98.4938936,98.3660919,98.5546045,98.6536989,98.5307441,98.6116869,98.4732055,98.6731685,98.401477,98.4338019,98.2970826,98.617133,98.3794304,98.5513392))
bev <-data.frame(EarlyVotingLocations = as.data.frame(EarlyVotingLocations),TotalEarlyVotes= as.data.frame(TotalEarlyVotes), lat = as.data.frame(lat), lng = as.data.frame(lng), streetaddress = as.data.frame(streetaddress), zip = as.data.frame(zip))Now we use str to take a peek at the structure. `l
str(bev)## 'data.frame': 43 obs. of 6 variables:
## $ EarlyVotingLocations: Factor w/ 43 levels "Bexar County Elections",..: 1 2 3 4 5 6 7 8 9 10 ...
## $ TotalEarlyVotes : num 7391 5341 19544 9331 4965 ...
## $ lat : num 29.4 29.4 29.6 29.5 29.4 ...
## $ lng : num -98.5 -98.5 -98.5 -98.5 -98.4 ...
## $ streetaddress : Factor w/ 43 levels "1 UTSA Circle",..: 4 19 30 14 17 5 24 28 35 16 ...
## $ zip : num 78207 78205 78232 78213 78202 ...Before we get carried away, lets prep all the neccessary packages were going to use to extract Census data, and make our map.
library("knitr")
library("leaflet")
library("dplyr")
library("acs")
library("tigris")
acs.tables.install()Following the guidance of Marcel Merchat we extract GIS and income data for Bexar County.
gis_tracts <- tracts(state = 'TX', county = c('Bexar'))
income_data <- acs.fetch(endyear = 2016, geography = geo.make(state = "TX", county = "Bexar", tract = "*"), variable = "B19013_001", key=acs.tables.install())Further following Merchat’s guidance we create objects to clean up the Census Data and make it easier to create our pretty and layered map.
exprvec <- gis_tracts$GEOID
pattern <- "^.+([[:digit:]]{7})"
temp1 <- sapply(regmatches(exprvec, gregexpr(pattern, exprvec)),
function(e) regmatches(e, regexec(pattern, e)))
gis_tracts$GEOID <- do.call(cbind, temp1)[2,]
income_df <- as.data.frame(income_data@estimate)
income_df$GEOID <- paste0(as.character(income_data@geography$state),
as.character(income_data@geography$county),
income_data@geography$tract)
colnames(income_df) <- c("hhincome","GEOID")
exprvec <- income_df$GEOID
temp1 <- sapply(regmatches(exprvec, gregexpr(pattern, exprvec)),
function(e) regmatches(e, regexec(pattern, e)))
income_df$GEOID <- do.call(cbind, temp1)[2,]
data_merged <- geo_join(gis_tracts, income_df, "GEOID", "GEOID")
pal <- colorQuantile("Greens", NULL, n = 5)Our finished map will have information on voter turnout illustrated by circles, with the magnitude of the circle representing turnout. Median household income by Census District will be illustrated by lighter and darker shades of green, representing districts with a smaller and larger median household income, respectively.
addPopups() here adds our county’s label at the coordinates we want. addCircles() adds the circles with a border thinkness, weight =, of 3, specified circle radius, radius =, meant to hightlight the variances in turnout among different locations, and label, popup=, consisting of the location and turnout. addPolygons() makes the layer of census bureau information,from data = data_merged, with popup =, containing the label median household income per district, and the rest being about how it looks. addLegend() makes a legend of the shades and their respective quintilie. setView() sets the the view of the map, with the coordinates and zoom.
bev %>%
leaflet() %>%
addTiles() %>%
addPopups(-98.5, 29.5,
"Bexar County, Texas",
options = popupOptions(closeButton = FALSE)) %>%
addPolygons(data = data_merged,
fillColor = pal(data_merged$hhincome),
fillOpacity = 0.7,
weight = 0.2,
smoothFactor = 0.2,
popup = paste0("Median household income: ", as.character( data_merged$hhincome))) %>%
addCircles(weight = 3, radius = (sqrt(bev$TotalEarlyVotes*150))*log10 (bev$TotalEarlyVotes)^.4, popup = paste(bev$EarlyVotingLocations,":",bev$TotalEarlyVotes)) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addLegend(pal = pal, values = data_merged$hhincome,
position = "topright",
title = "Income in Bexar County") %>%
setView(-98.5, 29.45, zoom = 9.25)## Assuming "lng" and "lat" are longitude and latitude, respectively