Updates to cycling_route_analysis.Rmd
This commit is contained in:
parent
91a5390480
commit
220d9a0e8b
@ -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 ",
|
||||
|
Loading…
x
Reference in New Issue
Block a user