library(tidyverse)
library(ggplot2)
library(ggthemes)
library(socviz)
library(maps)
library(mapproj)
library(questionr)
library(viridis)
library(leaflet)
library(tidycensus)lab 7
Movietavern and Population Overlay - With Bonus
ACQUIRE THE DATA
The following code will read the dataset in directly from data.world.
https://data.world/data-hut/movietavern-location-dataset
movieUS <- read.csv("https://query.data.world/s/5xsdaezg32gho5hy4xklnwjsbuyuis?dws=00000", header=TRUE, stringsAsFactors=FALSE)CREATE MAP FOR TEXAS LOCATIONS
Map Movietavern store locations JUST FOR in TX using leaflet package.
movieUS <- movieUS %>% filter(state == "TX")
movieUS %>% leaflet(width = "100%") %>%
addTiles() %>%
setView(-97.7431, 30.2672, zoom = 6) %>%
addMarkers(lat = ~latitude,
lng = ~longitude,
popup = movieUS$name)ACQUIRE ARKANSAS COUNTY-LEVEL POPULATION DATA FROM THE US CENSUS
Obtain your own census api key at: https://api.census.gov/data/key_signup.html
We will use the api key to directly download population data from the census.
library(tidyverse)
library(tidycensus)
library(leaflet)
library(sf)
library(stringr)
census_api_key("eef2a90c317f2da978bdb4d7447a17d4bbd24dad")
tx_pop <-
get_acs(geography = "county",
variables = "B01003_001",
state = "TX",
geometry = TRUE)
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 6%
|
|===== | 7%
|
|====== | 8%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%as_tibble(tx_pop) # A tibble: 254 × 6
GEOID NAME variable estimate moe geometry
<chr> <chr> <chr> <dbl> <dbl> <MULTIPOLYGON [°]>
1 48273 Kleberg County, Texas B01003_… 30860 NA (((-97.3178 27.49456, -9…
2 48391 Refugio County, Texas B01003_… 6718 NA (((-97.54085 28.16496, -…
3 48201 Harris County, Texas B01003_… 4726177 NA (((-94.97839 29.68365, -…
4 48443 Terrell County, Texas B01003_… 862 252 (((-102.5669 30.28327, -…
5 48229 Hudspeth County, Tex… B01003_… 3329 NA (((-105.998 32.00233, -1…
6 48205 Hartley County, Texas B01003_… 5369 NA (((-103.0422 35.82522, -…
7 48351 Newton County, Texas B01003_… 12333 NA (((-93.91113 31.15807, -…
8 48373 Polk County, Texas B01003_… 50536 NA (((-95.20018 30.82457, -…
9 48139 Ellis County, Texas B01003_… 195509 NA (((-97.08703 32.39219, -…
10 48491 Williamson County, T… B01003_… 617396 NA (((-98.04989 30.62415, -…
# ℹ 244 more rowsOVERLAY MOVIETAVERN TO POPULATION
Let’s map the AR Population Census using the leaflet package.
This time we are using a different provider for the map: OpenStreetMap
Try swapping other maps – see a few below in the commented code.
MapPalette <- colorQuantile(palette = "viridis", domain = tx_pop$estimate, n = 20)
tx_pop %>%
st_transform(crs = "+proj=longlat +datum=WGS84") %>%
leaflet(width = "100%", height = 500) %>%
addProviderTiles(provider = "Esri.WorldStreetMap") %>%
addPolygons(popup = ~NAME,
stroke = FALSE,
smoothFactor = 0,
fillOpacity = 0.6,
color = ~ MapPalette(estimate)) %>%
addLegend("bottomright",
pal = MapPalette,
values = ~ estimate,
title = "Population Percentiles",
opacity = 1) %>%
addCircleMarkers(data = movieUS,
lat = movieUS$latitude,
lng = movieUS$longitude,
popup = movieUS$name,
weight = 1,
radius=4,
color = "blue",
opacity = 1)## Alternative maps (just swap out the above)
#addProviderTiles(provider = "Esri.WorldStreetMap") %>%
#addProviderTiles(provider = "OpenStreetMap") %>%
#addProviderTiles(provider = "Esri.WorldPhysical") %>%
#addProviderTiles(provider = "Esri.WorldImagery") %>%
#addProviderTiles(provider = "Esri.WorldTopoMap") %>% ADD ON STARBUCKS LOCATIONS
Note – modified code slightly in the addPolygons() function to outline each county border in gray
whataburgerUS <- read.csv("https://query.data.world/s/an4baowuctocogcc5l2dlwa3rl7pae?dws=00000", header=TRUE, stringsAsFactors=FALSE)
sbar <- whataburgerUS%>% filter(state=="TX")
rm(whataburgerUS)tx_pop %>%
st_transform(crs = "+proj=longlat +datum=WGS84") %>%
leaflet(width = "100%", height = 500) %>%
addProviderTiles(provider = "Esri.WorldStreetMap") %>%
addPolygons(popup = ~NAME,
stroke = TRUE, # Enable stroke for the border
color = "gray", # Set border color to gray
weight = 1, # Set the thickness of the border
smoothFactor = 0,
fillOpacity = 0.6,
fillColor = ~ MapPalette(estimate)) %>%
addLegend("bottomright",
pal = MapPalette,
values = ~ estimate,
title = "Population Percentiles",
opacity = 1) %>%
addCircleMarkers(data = movieUS,
lat = movieUS$latitude,
lng = movieUS$longitude,
popup = movieUS$name,
weight = 1,
radius=4,
color = "blue",
opacity = 1) %>%
addCircleMarkers(data = sbar,
lat = sbar$latitude,
lng = sbar$longitude,
popup = sbar$name,
weight = 1,
radius=4,
color = "red",
opacity = 1)