Updates to cycling_route_analysis.Rmd

This commit is contained in:
syounkin 2024-11-01 14:05:54 -05:00
parent 91a5390480
commit 220d9a0e8b

View File

@ -1,5 +1,5 @@
---
title: "East High Active Travel"
title: "East High Cycling Routes"
output:
html_document:
toc: true
@ -80,23 +80,45 @@ register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1,
```
# Analysis
## Subset Addresses Within 3 Miles
```{r analysisPreamble, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
radius <- 3 # miles
levels <- c(1)
res <- 100
threshold <- 1
```
## Subset Addresses Within `r radius` Miles
```{r cycleBoundary, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
radius <- 3 # miles
cycle_boundary_m <- radius*1609
school_focus <- data.frame(name = c("East High School"), NCES_CODE = c("550852000925"))
#school_focus <- data.frame(name = c("IMAP"), NCES_CODE = c("550008203085"))
cycle_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance(
loc = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE),
breaks = c(cycle_boundary_m),
res = 80)
), units::set_units(1, km^2))
# breaks = c(cycle_boundary_m),
breaks = cycle_boundary_m*levels,
res = res)
), units::set_units(threshold, km^2))
addresses_near <- st_intersection(addresses, cycle_boundary_poly)
```
Notes:
- _osrmIsoDistance_ is the primary function in the above chunk.
- This function computes areas that are reachable within a given road
distance from a point and returns the reachable regions as
polygons. These areas of equal travel distance are called isodistances.
- Input is a point represented as an sf object (extended
data.frame-like objects with a simple feature list column) could be
other classes, e.g., vector of coods, data.frame of lat tand
long. etc.
- Arguments to osrmIsodistances used here are breaks and res
- breaks: a numeric vector of break values to define isodistance areas, in meters.
- res: number of points used to compute isodistances, one side of the
square grid, the total number of points will be res*res. Increase res to obtain more detailed isodistances.
- _fill\_holes_ is also used with a threshold of `r threshold` km^2.
- _st\_intersection_ is also used on sf objects (simple features?)
## Calculate Routes
@ -110,10 +132,12 @@ for(i in addresses_near$number) {
message(paste0("done - ", i, "of", max(addresses_near$number)))
}
routes <- bind_rows(routes)
```
Notes:
- _osrmRoute_ is the primary function used above.
## Combine routes with Bike LTS
```{r routeslts, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
@ -127,6 +151,9 @@ bike_lts_buffer["student_use"] <- unlist(lapply(st_intersects(bike_lts_buffer, r
bike_lts <- st_join(bike_lts, bike_lts_buffer %>% select(OBJECTID, student_use))
```
Notes:
# Make Maps
@ -151,7 +178,7 @@ basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite")
```
## Generate map of addresses
```{r mapaddresses, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
```{r mapaddresses, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
ggmap(basemap) +
labs(title = paste0("Student homes at ",
@ -199,12 +226,12 @@ ggsave(file = paste0("figures/",
```
## Generate map of routes
```{r maproutes, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
```{r maproutes, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# generate map
ggmap(basemap) +
labs(title = paste0("Cycling routes for students at ",
school_focus %>% pull(name)),
subtitle = "only showing routes within the ??? mile cycling boundary",
subtitle = paste0("only showing routes within the ", radius, " mile cycling boundary"),
x = NULL,
y = NULL,
color = NULL,
@ -250,7 +277,7 @@ ggsave(file = paste0("figures/",
```
## Generate map of routes with LTS
```{r maprouteslts, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
```{r maprouteslts, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# generate map
ggmap(basemap) +
labs(title = paste0("Cycling routes for students at ",