mini-3
2022-10-02
Mini 3
library(tidycensus)
library(sf)## Linking to GEOS 3.9.1, GDAL 3.4.3, PROJ 7.2.1; sf_use_s2() is TRUElibrary(tmap)
library(jsonlite)
library(tidyverse)## ── Attaching packages
## ───────────────────────────────────────
## tidyverse 1.3.2 ──## ✔ ggplot2 3.3.6 ✔ purrr 0.3.4
## ✔ tibble 3.1.8 ✔ dplyr 1.0.9
## ✔ tidyr 1.2.0 ✔ stringr 1.4.0
## ✔ readr 2.1.2 ✔ forcats 0.5.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ purrr::flatten() masks jsonlite::flatten()
## ✖ dplyr::lag() masks stats::lag()library(httr)
library(jsonlite)
library(reshape2)##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smithslibrary(here)## here() starts at C:/Users/fhasan30/OneDrive - Georgia Institute of Technology/Documents/CP 8883library(yelpr)
library(knitr)
#find commuting variables
load_variables(year = 2020, dataset="acs5")## # A tibble: 27,850 × 4
## name label concept geography
## <chr> <chr> <chr> <chr>
## 1 B01001_001 Estimate!!Total: SEX BY AGE block group
## 2 B01001_002 Estimate!!Total:!!Male: SEX BY AGE block group
## 3 B01001_003 Estimate!!Total:!!Male:!!Under 5 years SEX BY AGE block group
## 4 B01001_004 Estimate!!Total:!!Male:!!5 to 9 years SEX BY AGE block group
## 5 B01001_005 Estimate!!Total:!!Male:!!10 to 14 years SEX BY AGE block group
## 6 B01001_006 Estimate!!Total:!!Male:!!15 to 17 years SEX BY AGE block group
## 7 B01001_007 Estimate!!Total:!!Male:!!18 and 19 years SEX BY AGE block group
## 8 B01001_008 Estimate!!Total:!!Male:!!20 years SEX BY AGE block group
## 9 B01001_009 Estimate!!Total:!!Male:!!21 years SEX BY AGE block group
## 10 B01001_010 Estimate!!Total:!!Male:!!22 to 24 years SEX BY AGE block group
## # … with 27,840 more rows
## # ℹ Use `print(n = ...)` to see more rowscensus data for the commuting
#census
a <- census_api_key(Sys.getenv("census_api"))## To install your API key for use in future sessions, run this function with `install = TRUE`.b <- Sys.getenv("census_api")
# census tract boundary with commuter variable
tract <- suppressMessages(
get_acs(geography = "tract", # or "block group", "county", "state" etc.
state = "GA",
county = c("fulton","dekalb"),
variables = c(trans.bicycle = "B08301_018"
),
year = 2019,
survey = "acs5", # American Community Survey 5-year estimate
geometry = TRUE, # returns sf objects
output = "wide") # wide vs. long
)##
|
| | 0%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 21%
|
|================ | 22%
|
|================= | 24%
|
|================= | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 29%
|
|===================== | 29%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|========================= | 36%
|
|========================== | 37%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================= | 47%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|===================================== | 52%
|
|====================================== | 54%
|
|======================================= | 56%
|
|======================================== | 57%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|============================================ | 63%
|
|============================================= | 64%
|
|=============================================== | 67%
|
|================================================ | 68%
|
|================================================= | 70%
|
|================================================== | 72%
|
|==================================================== | 74%
|
|===================================================== | 75%
|
|====================================================== | 77%
|
|======================================================= | 79%
|
|========================================================= | 81%
|
|========================================================== | 82%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================== | 88%
|
|=============================================================== | 90%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|=================================================================== | 95%
|
|==================================================================== | 97%
|
|===================================================================== | 99%
|
|======================================================================| 100%tract <- tract %>%
select(GEOID,
trans.bicycle = trans.bicycleE)
#find the areas where people are biking the most
tm_shape(tract) + tm_polygons("trans.bicycle")
# Function: Get tract-wise radius
get_r <- function(poly, epsg_id){
bb <- st_bbox(poly) #bounding box for polygon
bb_corner <- st_point(c(bb[1], bb[2])) %>% st_sfc(crs = epsg_id)#lat and long
#centroid of the bounding box
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()
r <- st_distance(bb_corner, bb_center) #finding distance
bb_center$radius <- r*1.2 # making circle a little bigger than the census tract
return(bb_center)
}
epsg_id <- 4326 #measures distance in meters
#empty vector
r4all_loop <- vector("list", nrow(tract))
# for loop adding info to vector
for (i in 1:nrow(tract)){
r4all_loop[[i]] <- tract %>%
st_transform(crs = epsg_id) %>%
st_geometry() %>%
.[[i]] %>%
get_r(epsg_id = epsg_id)
}
r4all_loop <- bind_rows(r4all_loop)
#applying this fucntion to each cencus tract
r4all_apply <- tract %>%
st_geometry() %>%
st_transform(crs = epsg_id) %>%
lapply(., function(x) get_r(x, epsg_id = epsg_id))
r4all_apply <- bind_rows(r4all_apply)
# identical?
identical(r4all_apply, r4all_loop)## [1] TRUE# putting xy coordinates in two columns
ready_4_yelp <- r4all_apply %>%
mutate(x = st_coordinates(.)[,1],
y = st_coordinates(.)[,2])
tmap_mode('view')## tmap mode set to interactive viewingready_4_yelp[1:10,] %>%
# Draw a buffer
st_buffer(., dist = .$radius) %>%
# buffer shown in red
tm_shape(.) + tm_polygons(alpha = 0.5, col = 'red') +
# original polygon shown in blue
tm_shape(tract[1:10,]) + tm_borders(col= 'blue')Yelp data on categories = bikerentals for Atlanta metro
#accessing Yelp API
api_key = Sys.getenv("yelp_api")
which_tract <- 1
#getting bike data
bike_rentals = business_search(api_key = api_key,
category = '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(bike_rentals, head)## $businesses
## id alias
## 1 eG-UO83g_5zDk70FIJbm2w south-city-kitchen-midtown-atlanta-2
## 2 _iqFvc3zToL08WZrNeFP3Q stk-steakhouse-atlanta-2
## 3 3ehyrexo3WcoTy74c2jDKA flying-biscuit-café-midtown-atlanta
## 4 tDv2qG4N7PsYLN0QYuuaZQ bulla-gastrobar-atlanta-2
## 5 hmrRb7qX3K705MuxHHfgNA cafe-intermezzo-midtown-atlanta-3
## 6 Gwi9PMVb61nrrpUNa9_wfQ lure-atlanta
## name
## 1 South City Kitchen Midtown
## 2 STK Steakhouse
## 3 Flying Biscuit Café - Midtown
## 4 Bulla Gastrobar
## 5 Cafe Intermezzo - Midtown
## 6 Lure
## image_url
## 1 https://s3-media3.fl.yelpcdn.com/bphoto/L1qX2ttHqvNMqgsw_JQNLQ/o.jpg
## 2 https://s3-media1.fl.yelpcdn.com/bphoto/cHKMsDThzTVpoRqS39lPXA/o.jpg
## 3 https://s3-media4.fl.yelpcdn.com/bphoto/9PiLUl2SWUyIQhOECrBcsA/o.jpg
## 4 https://s3-media1.fl.yelpcdn.com/bphoto/ZCovd0lMaKQpasok3yivWA/o.jpg
## 5 https://s3-media4.fl.yelpcdn.com/bphoto/9zuh2IfmOwYmkJPnwgH7rw/o.jpg
## 6 https://s3-media2.fl.yelpcdn.com/bphoto/TIzVTGEQQfP2RN950zWrJw/o.jpg
## is_closed
## 1 FALSE
## 2 FALSE
## 3 FALSE
## 4 FALSE
## 5 FALSE
## 6 FALSE
## url
## 1 https://www.yelp.com/biz/south-city-kitchen-midtown-atlanta-2?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## 2 https://www.yelp.com/biz/stk-steakhouse-atlanta-2?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## 3 https://www.yelp.com/biz/flying-biscuit-caf%C3%A9-midtown-atlanta?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## 4 https://www.yelp.com/biz/bulla-gastrobar-atlanta-2?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## 5 https://www.yelp.com/biz/cafe-intermezzo-midtown-atlanta-3?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## 6 https://www.yelp.com/biz/lure-atlanta?adjust_creative=bYB2eEjjKRvYZCw5ZxM2xQ&utm_campaign=yelp_api_v3&utm_medium=api_v3_business_search&utm_source=bYB2eEjjKRvYZCw5ZxM2xQ
## review_count
## 1 2945
## 2 1779
## 3 1802
## 4 761
## 5 1376
## 6 637
## categories
## 1 southern, Southern
## 2 steak, newamerican, cocktailbars, Steakhouses, American (New), Cocktail Bars
## 3 breakfast_brunch, southern, newamerican, Breakfast & Brunch, Southern, American (New)
## 4 spanish, gastropubs, tapas, Spanish, Gastropubs, Tapas Bars
## 5 cafes, bars, desserts, Cafes, Bars, Desserts
## 6 seafood, bars, newamerican, Seafood, Bars, American (New)
## rating coordinates.latitude coordinates.longitude transactions price
## 1 4.5 33.78600 -84.38456 delivery $$
## 2 3.5 33.78418 -84.38283 delivery, pickup $$$$
## 3 4.0 33.78200 -84.38015 delivery, pickup $$
## 4 4.0 33.78354 -84.38483 delivery, pickup $$
## 5 3.5 33.78331 -84.38356 delivery, pickup $$
## 6 4.0 33.78500 -84.38452 delivery $$
## location.address1 location.address2 location.address3 location.city
## 1 1144 Crescent Ave NE Atlanta
## 2 1075 Peachtree St NE Atlanta
## 3 1001 Piedmont Ave Atlanta
## 4 60 11th St NE <NA> Atlanta
## 5 1065 Peachtree St NE Atlanta
## 6 1106 Crescent Ave NE Atlanta
## location.zip_code location.country location.state
## 1 30309 US GA
## 2 30309 US GA
## 3 30309 US GA
## 4 30309 US GA
## 5 30309 US GA
## 6 30309 US GA
## location.display_address phone display_phone
## 1 1144 Crescent Ave NE, Atlanta, GA 30309 +14048737358 (404) 873-7358
## 2 1075 Peachtree St NE, Atlanta, GA 30309 +14047930144 (404) 793-0144
## 3 1001 Piedmont Ave, Atlanta, GA 30309 +14048748887 (404) 874-8887
## 4 60 11th St NE, Atlanta, GA 30309 +14049006926 (404) 900-6926
## 5 1065 Peachtree St NE, Atlanta, GA 30309 +14708783137 (470) 878-3137
## 6 1106 Crescent Ave NE, Atlanta, GA 30309 +14048173650 (404) 817-3650
## distance
## 1 242.850935
## 2 4.314353
## 3 344.764641
## 4 196.780359
## 5 118.986629
## 6 179.474837
##
## $total
## [1] 159
##
## $region
## $region$center
## $region$center$longitude
## [1] -84.38286
##
## $region$center$latitude
## [1] 33.78421names(bike_rentals)## [1] "businesses" "total" "region"paste0("is it a data.frame?: ", is.data.frame(bike_rentals$businesses), ", ",
" how many rows?: ", nrow(bike_rentals$businesses), ", ",
" how many columns?: ", ncol(bike_rentals$businesses))## [1] "is it a data.frame?: TRUE, how many rows?: 50, how many columns?: 16"#I created this data frame as a Rscript but it wouldn't load in the markdown file so I saved it and opened it here.
yelp_sf<-readRDS(file="yelp_sf.Rda")Clean the data
-remove rows outside boundary
census <- st_read("https://raw.githubusercontent.com/BonwooKoo/UrbanAnalytics2022/main/Lab/module_0/testdata.geojson") ## Reading layer `testdata' from data source
## `https://raw.githubusercontent.com/BonwooKoo/UrbanAnalytics2022/main/Lab/module_0/testdata.geojson'
## using driver `GeoJSON'
## Simple feature collection with 519 features and 8 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -84.85071 ymin: 33.35246 xmax: -84.02371 ymax: 34.18629
## Geodetic CRS: WGS 84yelp_sf2 <- yelp_sf %>%
st_as_sf(coords=c("coordinates.longitude", "coordinates.latitude"), crs = 4326)
# sf subsets
yelp_sf <- yelp_sf2[census %>%
filter(county %in% c("Fulton County", "DeKalb County")) %>%
st_union(), ,op = st_intersects]- delete duplicated rows
yelp_unique <- yelp_sf %>%
distinct(id, .keep_all=T)
glue::glue("Before dropping NA, there were {nrow(yelp_sf)} rows. After dropping them, there are {nrow(yelp_unique)} rows") %>%
print()## Before dropping NA, there were 206 rows. After dropping them, there are 14 rows- flatten
concate_list <- 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)
}
#flatten transactions and catagories
yelp_flat <- yelp_unique %>%
mutate(transactions = transactions %>%
map_chr(., function(x) str_c(x, collapse=", ")),
categories = categories %>% map_chr(concate_list))
yelp_flat %>% print(width = 1000)## Simple feature collection with 14 features and 16 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -84.47153 ymin: 33.61131 xmax: -84.16982 ymax: 34.05956
## Geodetic CRS: WGS 84
## # A tibble: 14 × 17
## id alias
## * <chr> <chr>
## 1 FK7-M9BGyCgpEmVifcPfoA aztec-cycles-stone-mountain
## 2 JkkHRgYj0mvdgbMXFm436w civil-bikes-atlanta
## 3 UmftRC3h0h_owHEm5ZLp7Q jump-atlanta-2
## 4 kJJiJqGbiO_QXmdhol3hIQ british-and-american-bikes-atlanta
## 5 ot4UyUsRAlTFudTlCVRMrQ pedego-electric-bikes-alpharetta-alpharetta
## 6 LsNS77QoD4wauKgGeCfxPQ dads-emissions-decatur-4
## 7 b3nacMG8PR77GNCaI4RBKA atlanta-bicycle-barn-atlanta
## 8 8PfRbXo6qhKliGDCp5l79g atlanta-pro-bikes-atlanta
## 9 rbf8bVY0cuqyGZtbn691lg pedego-electric-bikes-atlanta-atlanta-2
## 10 BozJwfoXvoDEUj-sgr7WDg podium-multisport-atlanta
## 11 OJVvH1CUZacuHjSLkhSKOg roswell-bicycles-roswell
## 12 vfp82FZBVz1Hcg6FwTjWcg relay-bike-share-atlanta
## 13 cRTM5f8ATvVr9lrKcOnWgg the-sport-factory-roswell
## 14 gcl6O-ZWTTra5ljEics_gw cloud-of-goods-atlanta-atlanta-2
## name
## * <chr>
## 1 Aztec Cycles
## 2 Civil Bikes
## 3 JUMP
## 4 British and American Bikes
## 5 Pedego Electric Bikes Alpharetta
## 6 Dad's Emissions
## 7 Atlanta Bicycle Barn
## 8 Atlanta Pro Bikes
## 9 Pedego Electric Bikes Atlanta
## 10 Podium Multisport
## 11 Roswell Bicycles
## 12 Relay Bike Share
## 13 The Sport Factory
## 14 Cloud of Goods - Atlanta
## image_url
## * <chr>
## 1 https://s3-media3.fl.yelpcdn.com/bphoto/re-aoEuun-QS1SE7dQCySQ/o.jpg
## 2 https://s3-media4.fl.yelpcdn.com/bphoto/JqTLT-chrqtbyuoB-52gdw/o.jpg
## 3 https://s3-media2.fl.yelpcdn.com/bphoto/D87H00XdLWZJS-LvQkTalA/o.jpg
## 4 https://s3-media2.fl.yelpcdn.com/bphoto/9I0G3Ge2yKFg6184t1XYEQ/o.jpg
## 5 https://s3-media2.fl.yelpcdn.com/bphoto/gPNidtknlSWKu3Bh4iOJ3Q/o.jpg
## 6 https://s3-media3.fl.yelpcdn.com/bphoto/_W7WHceEBLyPI86R2-3-Vw/o.jpg
## 7 https://s3-media3.fl.yelpcdn.com/bphoto/Ik2pMce41_MRcg3svjTbSQ/o.jpg
## 8 https://s3-media1.fl.yelpcdn.com/bphoto/1s0fhhJvN3z-SUPizRy5sw/o.jpg
## 9 https://s3-media2.fl.yelpcdn.com/bphoto/Z7KlxC0vcyoxOCSxbH3Rrg/o.jpg
## 10 https://s3-media1.fl.yelpcdn.com/bphoto/T78pUkBulcQ5osv4mVGTiQ/o.jpg
## 11 https://s3-media2.fl.yelpcdn.com/bphoto/1YUjKn4QEkVQG_eIH7wiXQ/o.jpg
## 12 https://s3-media4.fl.yelpcdn.com/bphoto/Ro45JHwmmQicHwwigTEdpg/o.jpg
## 13 https://s3-media2.fl.yelpcdn.com/bphoto/KbtggaK_z06YtHcweq5beg/o.jpg
## 14 https://s3-media4.fl.yelpcdn.com/bphoto/88hjMKknmHDpv3970N_-Wg/o.jpg
## is_closed
## * <lgl>
## 1 FALSE
## 2 FALSE
## 3 FALSE
## 4 FALSE
## 5 FALSE
## 6 FALSE
## 7 FALSE
## 8 FALSE
## 9 FALSE
## 10 FALSE
## 11 FALSE
## 12 FALSE
## 13 FALSE
## 14 FALSE
## url
## * <chr>
## 1 https://www.yelp.com/biz/aztec-cycles-stone-mountain?adjust_creative=bYB2eEj…
## 2 https://www.yelp.com/biz/civil-bikes-atlanta?adjust_creative=bYB2eEjjKRvYZCw…
## 3 https://www.yelp.com/biz/jump-atlanta-2?adjust_creative=bYB2eEjjKRvYZCw5ZxM2…
## 4 https://www.yelp.com/biz/british-and-american-bikes-atlanta?adjust_creative=…
## 5 https://www.yelp.com/biz/pedego-electric-bikes-alpharetta-alpharetta?adjust_…
## 6 https://www.yelp.com/biz/dads-emissions-decatur-4?adjust_creative=bYB2eEjjKR…
## 7 https://www.yelp.com/biz/atlanta-bicycle-barn-atlanta?adjust_creative=bYB2eE…
## 8 https://www.yelp.com/biz/atlanta-pro-bikes-atlanta?adjust_creative=bYB2eEjjK…
## 9 https://www.yelp.com/biz/pedego-electric-bikes-atlanta-atlanta-2?adjust_crea…
## 10 https://www.yelp.com/biz/podium-multisport-atlanta?adjust_creative=bYB2eEjjK…
## 11 https://www.yelp.com/biz/roswell-bicycles-roswell?adjust_creative=bYB2eEjjKR…
## 12 https://www.yelp.com/biz/relay-bike-share-atlanta?adjust_creative=bYB2eEjjKR…
## 13 https://www.yelp.com/biz/the-sport-factory-roswell?adjust_creative=bYB2eEjjK…
## 14 https://www.yelp.com/biz/cloud-of-goods-atlanta-atlanta-2?adjust_creative=bY…
## review_count categories rating
## * <int> <chr> <dbl>
## 1 54 Bikes, Bike Repair/Maintenance, Bike Rentals 5
## 2 9 Bike Rentals, Historical Tours 4.5
## 3 1 Scooter Rentals, Bike Rentals 1
## 4 2 Motorcycle Repair, Bike Rentals 5
## 5 7 Bike Rentals, Bikes, Bike Repair/Maintenance 5
## 6 64 Smog Check Stations, Bikes, Bike Rentals 4.5
## 7 124 Bike Rentals, Bike Repair/Maintenance, Bikes 4.5
## 8 40 Bike Repair/Maintenance, Bikes, Bike Rentals 4.5
## 9 9 Bikes, Bike Rentals, Bike Repair/Maintenance 4.5
## 10 19 Bikes, Bike Rentals 4.5
## 11 70 Bikes, Bike Rentals 4
## 12 12 Party Bike Rentals, Bike Rentals, Bike Sharing 2
## 13 1 Bike Repair/Maintenance, Bikes, Bike Rentals 1
## 14 1 Scooter Rentals, Baby Gear & Furniture, Bike Rentals 1
## coordinates$latitude $longitude transactions price location$address1
## * <dbl> <dbl> <chr> <chr> <chr>
## 1 33.8 -84.2 "" $$ "901 Main St"
## 2 33.7 -84.4 "" <NA> ""
## 3 33.7 -84.4 "" <NA> ""
## 4 33.9 -84.3 "" <NA> "4264 F Winters Chapel Rd"
## 5 34.0 -84.3 "" <NA> "6480 N Point Pkwy"
## 6 33.8 -84.3 "" $ "1707 Church St"
## 7 33.8 -84.4 "" $$ "151 Sampson St NE"
## 8 33.8 -84.4 "" <NA> "1039 N Highland Ave NE"
## 9 33.7 -84.4 "" <NA> "414 Bill Kennedy Way"
## 10 33.8 -84.3 "" $$$ "1167 Zonolite Pl NE"
## 11 34.0 -84.3 "" $$$ "670 Houze Way"
## 12 33.6 -84.5 "" <NA> ""
## 13 34.1 -84.3 "" $$$$ "720 Hembree Pl"
## 14 33.8 -84.4 "" <NA> <NA>
## $address2 $address3 $city $zip_code $country $state
## * <chr> <chr> <chr> <chr> <chr> <chr>
## 1 "" "" Stone Mountain 30083 US GA
## 2 <NA> "" Atlanta 30312 US GA
## 3 "" <NA> Atlanta 30301 US GA
## 4 "" "" Atlanta 30360 US GA
## 5 "Ste 1100b" <NA> Alpharetta 30022 US GA
## 6 <NA> <NA> Decatur 30030 US GA
## 7 "" "" Atlanta 30312 US GA
## 8 <NA> "" Atlanta 30306 US GA
## 9 "Ste 101" <NA> Atlanta 30316 US GA
## 10 "Ste A2" "" Atlanta 30306 US GA
## 11 "" "" Roswell 30076 US GA
## 12 "" <NA> Atlanta 30349 US GA
## 13 "" <NA> Roswell 30076 US GA
## 14 <NA> "" Atlanta 30303 US GA
## $display_address phone display_phone distance geometry
## * <list> <chr> <chr> <dbl> <POINT [°]>
## 1 <chr [2]> +16786369043 (678) 636-9043 22818. (-84.16982 33.80586)
## 2 <chr [1]> +14043238754 (404) 323-8754 366. (-84.37784 33.74468)
## 3 <chr [1]> +18333006106 (833) 300-6106 1238. (-84.39146 33.74827)
## 4 <chr [2]> +17704518868 (770) 451-8868 1715. (-84.27059 33.91903)
## 5 <chr [3]> +14042810264 (404) 281-0264 2501. (-84.29336 34.0444)
## 6 <chr [2]> +14042946644 (404) 294-6644 1428. (-84.28105 33.79757)
## 7 <chr [2]> +17708732413 (770) 873-2413 1192. (-84.36515 33.75833)
## 8 <chr [2]> +14042541230 (404) 254-1230 689. (-84.35415 33.78293)
## 9 <chr [3]> +14049753915 (404) 975-3915 1453. (-84.35797 33.74172)
## 10 <chr [3]> +14048923400 (404) 892-3400 2222. (-84.34143 33.8051)
## 11 <chr [2]> +17706424057 (770) 642-4057 2842. (-84.34202 34.04687)
## 12 <chr [1]> +16787109900 (678) 710-9900 7916. (-84.47153 33.61131)
## 13 <chr [2]> +16783889835 (678) 388-9835 2253. (-84.31985 34.05956)
## 14 <chr [1]> +14075453103 (407) 545-3103 933. (-84.38997 33.75319)- delete rows with missing coordinate data
yelp_flat %>%
map_dbl(., function(x) sum(is.na(x)))## id alias name image_url is_closed
## 0 0 0 0 0
## url review_count categories rating coordinates
## 0 0 0 0 0
## transactions price location phone display_phone
## 0 8 11 0 0
## distance geometry
## 0 0#no missing coordinates but just in case
yelp_in<-yelp_flat %>%drop_na(coordinates)Associations between bike rental and bike commuting
#append census data
tract <- suppressMessages(
get_acs(geography = "tract", # or "block group", "county", "state" etc.
state = "GA",
county = c("fulton","dekalb"),
variables = c(
trans.bicycle = "B08301_018",
hhincome = 'B19019_001'
),
year = 2019,
survey = "acs5", # American Community Survey 5-year estimate
geometry = TRUE, # returns sf objects
output = "wide") # wide vs. long
)
tract<-separate(tract, NAME, sep=", ", into = c("tract", "county","state"))
census_sf <- tract %>% st_sf()
yelp_in<- yelp_in%>% st_sf()
#make them the same CRS
census_sf<-census_sf %>%st_transform(crs = st_crs(yelp_in))
bike_in_tract <- st_join(census_sf, yelp_in, join = st_intersects)
bike_count_tract <- count(as_tibble(bike_in_tract), GEOID) %>%
print()## # A tibble: 349 × 2
## GEOID n
## <chr> <int>
## 1 13089020100 1
## 2 13089020200 1
## 3 13089020300 1
## 4 13089020400 1
## 5 13089020500 1
## 6 13089020600 1
## 7 13089020700 1
## 8 13089020801 1
## 9 13089020802 1
## 10 13089020900 1
## # … with 339 more rows
## # ℹ Use `print(n = ...)` to see more rowstest <- st_join(census_sf, yelp_in %>% mutate(count = 1))
out <- test %>%
group_by(GEOID) %>%
summarise(count = sum(count, na.rm = T))
tm_shape(out) + tm_polygons(col = "count") + tm_shape(yelp_in) + tm_dots()tract2 <- census_sf %>%
left_join(out %>% st_set_geometry(NULL), by = "GEOID")
tm_shape(tract2)+ tm_polygons(col = "trans.bicycleE") +tm_shape(yelp_in) +tm_dots()- This visualizes the count variable, which counts how many bike rentals are in each tract, and then maps them as well as the trans.bicycle variable which tells us the amount of people commuting by bike in each tract. Most of the bike shops seem to be located centrally in the county and the amount of people using biking as a form of commuting is higher in those area’s as well. The areas where bike shops are scarce generally seem to have between 0-50 people that bike, which is the lowest category.
ggplot(tract2, aes(x=hhincomeE, y=count)) +
geom_point() +
ylab("Count of Bike Rentals per Tract ")## Warning: Removed 4 rows containing missing values (geom_point).
- This plot indicates that house hold income in a tract does not have an effect on available bike rentals.