Mini 3 by Kat Ginensky
load libraries
tidycensus::census_api_key(Sys.getenv("census_api"))## To install your API key for use in future sessions, run this function with `install = TRUE`.library(tidycensus)
library(sf)## Linking to GEOS 3.10.2, GDAL 3.4.1, PROJ 8.2.1; sf_use_s2() is TRUElibrary(tmap)## The legacy packages maptools, rgdal, and rgeos, underpinning the sp package,
## which was just loaded, will retire in October 2023.
## Please refer to R-spatial evolution reports for details, especially
## https://r-spatial.org/r/2023/05/15/evolution4.html.
## It may be desirable to make the sf package available;
## package maintainers should consider adding sf to Suggests:.
## The sp package is now running under evolution status 2
## (status 2 uses the sf package in place of rgdal)library(jsonlite)
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.2 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ purrr::flatten() masks jsonlite::flatten()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(httr)
library(jsonlite)
library(reshape2)##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smithslibrary(here)## here() starts at /home/rstudio/Mod 1library(yelpr)
library(knitr)
library(skimr)
library(ggplot2)yelp api
Get ACS data for counties and get atlanta boundary
FD_tract <- suppressMessages(
get_acs(geography = "tract", # or "block group", "county", "state" etc.
state = "GA",
county = c("Fulton", "Dekalb"),
variables = c(hhincome = 'B19019_001',
race.tot = "B02001_001",
race.white = "B02001_002",
race.black = "B02001_003",
trans.total = "B08006_001",
trans.car = "B08006_002",
trans.drovealone = "B08006_003",
trans.carpooled = "B08006_004", # Notice that I was not interested in 005-007 (2 person/ 4 person carpool etc.)
trans.pubtrans = "B08006_008", # Did not want to download any details about the type of public transport (009-0013)
trans.bicycle = "B08006_014",
trans.walk = "B08006_015",
trans.WfH = "B08006_017",
med_housexp = "B25104_001",
med_realestate_taxes = "B25103_001"
),
year = 2020,
survey = "acs5", # American Community Survey 5-year estimate
geometry = TRUE, # returns sf objects
output = "wide") # wide vs. long
)##
|
| | 0%
|
|= | 1%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============== | 20%
|
|================= | 24%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|========================= | 36%
|
|=========================== | 39%
|
|============================= | 41%
|
|============================= | 42%
|
|=============================== | 45%
|
|================================= | 47%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|===================================== | 53%
|
|====================================== | 54%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|============================================ | 62%
|
|============================================= | 64%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|=================================================== | 73%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%atlanta <- tigris::places('GA') %>%
filter(NAME == 'Atlanta') ## Retrieving data for the year 2021##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============== | 20%
|
|=============== | 21%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================= | 41%
|
|============================== | 42%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 46%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%FD_tract <- FD_tract[atlanta,]Check map
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(FD_tract) + tm_borders() + tm_shape(atlanta) + tm_borders(col = 'red')Selecting and renaming columns
FD_tract <- FD_tract %>%
select(GEOID,
hhincome = hhincomeE, # New name = old name
race.tot = race.totE,
race.white = race.whiteE,
race.black = race.blackE,
trans.total = trans.totalE,
trans.car = trans.carE,
trans.drovealone = trans.drovealoneE,
trans.carpooled = trans.carpooledE,
trans.pubtrans = trans.pubtransE,
trans.bicycle = trans.bicycleE,
trans.walk = trans.walkE,
trans.WfH = trans.WfHE,
Med_HHExp = med_housexpE,
med_RETaxes = med_realestate_taxesE)See what we have so far
tmap_mode("view")
## tmap mode set to interactive viewing
RE_Taxes <- tm_shape(FD_tract) + tm_polygons("med_RETaxes")
HH_exp <- tm_shape(FD_tract) + tm_polygons("Med_HHExp")
tmap_arrange(RE_Taxes, HH_exp)Function for finding centroid and bounding box for tracts
# Function: Get tract-wise radius
get_r <- function(poly, epsg_id){
#---------------------
# Takes: a single POLYGON or LINESTRTING
# Outputs: distance between the centroid of the bounding box and a corner of the bounding box
#---------------------
# Get bounding box of a given polygon
bb <- st_bbox(poly)
# Get lat & long coordinates of any one corner of the bounding box.
bb_corner <- st_point(c(bb[1], bb[2])) %>% st_sfc(crs = epsg_id)
# Get centroid of the bb
bb_center_x <- (bb[3]+bb[1])/2
bb_center_y <- (bb[4]+bb[2])/2
bb_center <- st_point(c(bb_center_x, bb_center_y)) %>% st_sfc(crs = epsg_id) %>% st_sf()
# Get the distance between bb_p and c
r <- st_distance(bb_corner, bb_center)
# Multiply 1.1 to make the circle a bit larger than the Census Tract.
# See the Yelp explanation of their radius parameter to see why we do this.
bb_center$radius <- r*1.2
return(bb_center)
}Apply the function to every polygon
## Using a loop -----------------------------------------------------------------
# Creating an empty vector of NA.
# Results will fill this vector
epsg_id <- 4326
r4all_loop <- vector("list", nrow(FD_tract))
# Starting a for-loop
for (i in 1:nrow(FD_tract)){
r4all_loop[[i]] <- FD_tract %>%
st_transform(crs = epsg_id) %>%
st_geometry() %>%
.[[i]] %>%
get_r(epsg_id = epsg_id)
}
r4all_loop <- bind_rows(r4all_loop)
# Using a functional -----------------------------------------------------------
# We use a functional (sapply) to apply this custom function to each Census Tract.
r4all_apply <- FD_tract %>%
st_geometry() %>%
st_transform(crs = epsg_id) %>%
lapply(., function(x) get_r(x, epsg_id = epsg_id))
r4all_apply <- bind_rows(r4all_apply)
# Are these two identical?
identical(r4all_apply, r4all_loop)## [1] TRUE# Appending X Y coordinates as seprate columns
ready_4_yelp <- r4all_apply %>%
mutate(x = st_coordinates(.)[,1],
y = st_coordinates(.)[,2])Visualize again
tmap_mode('view')## tmap mode set to interactive viewing# Select the first 10 rows
ready_4_yelp[1:10,] %>%
# Draw a buffer centered at the centroid of Tract polygons.
# Radius of the buffer is the radius we just calculated using loop
st_buffer(., dist = .$radius) %>%
# Display this buffer in red
tm_shape(.) + tm_polygons(alpha = 0.5, col = 'red') +
# Display the original polygon in blue
tm_shape(FD_tract[1:10,]) + tm_borders(col= 'blue')Download Yelp data on categories = bikerentals for the City of Atlanta.
which_tract <- 1
test <- business_search(api_key = yelp_api, # like we did for census, store your api key
categories = 'bikerentals', # return only bikerentals
latitude = ready_4_yelp$y[which_tract],
longitude = ready_4_yelp$x[which_tract],
offset = 0, # 1st page, 1st obs
radius = round(ready_4_yelp$radius[which_tract]), # radius requires integer value
limit = 50) # how many business per page## No encoding supplied: defaulting to UTF-8.lapply(test, head)## $businesses
## list()
##
## $total
## [1] 0
##
## $region
## $region$center
## $region$center$longitude
## [1] -84.33977
##
## $region$center$latitude
## [1] 33.75448zero results
names(test)## [1] "businesses" "total" "region"# Business
paste0("is it a data.frame?: ", is.data.frame(test$businesses), ", ",
" how many rows?: ", nrow(test$businesses), ", ",
" how many columns?: ", ncol(test$businesses))## [1] "is it a data.frame?: FALSE, how many rows?: , how many columns?: "# Collapsing the list into a data.frame
yelp_all <- ready_for_yelp %>% bind_rows() %>% as_tibble()
# print
yelp_all %>% print(width=1000)# Extract coordinates
yelp_sf <- yelp_all %>%
mutate(x = .$coordinates$longitude,
y = .$coordinates$latitude) %>%
filter(!is.na(x) & !is.na(y)) %>%
st_as_sf(coords = c("x", "y"), crs = 4326)
# Map
tm_shape(yelp_sf) +
tm_dots(col = "review_count", style="quantile")flatten data frame
yelp_flat_c <- yelp_sf %>%
jsonlite::flatten() %>%
as_tibble()
yelp_flat_c$coordinates%>% head()Concatenate the transaction column
yelp_concat_c <- yelp_flat_c %>%
mutate(transactions = transactions %>%
map_chr(., function(x) str_c(x, collapse=", ")))
head(yelp_concat_c)Function to flatten the category column
# Custom function that takes the data frame in "categories" column in Yelp data
# and returns a character vector
concate_list_c <- function(x){
# x is a data frame with columns "alias" and "title" from Yelp$categories
# returns a character vector containing category concatenated titles
titles <- x[["title"]] %>% str_c(collapse = ", ")
return(titles)
}
yelp_flat2_c <- yelp_concat_c %>%
mutate(categories = categories %>% map_chr(concate_list))
yelp_flat2_c %>% print(width = 1000)Removing duplicate values
yelp_unique_c <- yelp_flat2_c %>%
distinct(id, .keep_all=T)
glue::glue("Before dropping duplicated rows, there were {nrow(yelp_flat2_c)} rows. After dropping them, there are {nrow(yelp_unique_c)} rows") %>%
print()Are there any NA values
yelp_unique_c %>%
map_dbl(., function(x) sum(is.na(x)))
# map_dbl is a variant of map() which outputs
# numeric vector rather than a list.Checking for data cases outside of Atlanta border
# census boundary
census <- read_sf("/home/rstudio/Mod 1/chatham.shp") %>%
st_transform(4326)
# Converting yelp_unique_c into a sf object
yelp_sf_c <- yelp_unique_c %>%
st_as_sf(coords=c("coordinates.longitude", "coordinates.latitude"), crs = 4326)
# sf subsets
yelp_in_c <- yelp_sf_c[census %>%
st_union(), ,op = st_intersects]Compare tidy and messy data
glue::glue("nrow before: {nrow(yelp_all_c)} -> nrow after: {nrow(yelp_in_c)} \n
ncol before: {ncol(yelp_all_c)} -> ncol after: {ncol(yelp_in_c)} \n") %>%
print()Visualize
tmap_mode("view")
tm_shape(yelp_in_c) + tm_dots(col = "price")above are all things I would have done with yelp data
Make sure my original sf object is still intact
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(FD_tract) + tm_polygons()Percentage of bike commuters per census tract vs percent drivers per census tract
FD_tract <- FD_tract %>%
mutate(bikers = trans.bicycle*100/trans.total) %>%
mutate(drivers = trans.car*100/trans.total) %>%
filter(!is.na(bikers)) %>%
filter(!is.na(drivers))
head(FD_tract)tmap_mode("view")## tmap mode set to interactive viewing## tmap mode set to interactive viewing
bike <- tm_shape(FD_tract) + tm_fill(col = "bikers")
drive <- tm_shape(FD_tract) + tm_fill(col = "drivers")
tmap_arrange(bike, drive)The stark difference in the commuters that drive to work versus bike is very clear. It is also interesting that the census tracts with the highest percentage of bike commuters live in the center of the city.
Look at bikers compared to income
ggplot(data = FD_tract) +
geom_point(mapping = aes(x=bikers, y=hhincome)) +
labs(x = "Percent Bikers / Tract",
y = "Household Income",
color = "County in Census",
title = "Do Higher Income Households Bike Commute More?") +
theme_bw()## Warning: Removed 4 rows containing missing values (`geom_point()`).
########################################################## This plot
shows that at any income level there will be people that do not bike for
commuting, but it does seem to show that there is a slight increase in
bike commuters as income increases. This could be due to higher income
jobs allowing more flexibility in housing location - workers can choose
to live near bike accessible areas.
Compare walkers and bikers
FD_tract <- FD_tract %>%
mutate(walkers = trans.walk*100/trans.total) %>%
filter(!is.na(walkers))
head(FD_tract)tmap_mode("view")## tmap mode set to interactive viewingwalk <- tm_shape(FD_tract) + tm_fill(col = "walkers")
tmap_arrange(bike, walk)#It looks like the census tracts with high percentage of walkers overlap some of the census tracts with higher percentages of bikers. This indicates that these are have some advantage in their micromobility network, or workers in these areas tend to live very close to their work.