diff --git a/R/route_analysis.Rmd b/R/route_analysis.Rmd index 53d4bed..c9d287c 100644 --- a/R/route_analysis.Rmd +++ b/R/route_analysis.Rmd @@ -1,5 +1,5 @@ --- -title: "Route Analysis" +title: "East High Active Travel" output: html_document: toc: true @@ -11,6 +11,10 @@ editor_options: chunk_output_type: console --- +# Input Data & Configuration + +## Libraries + ```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} date() rm(list=ls()) @@ -26,32 +30,42 @@ fig.height <- 6 set.seed(1) ``` -# Main R script - -```{r Rscript, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} -## school focus -school_focus <- data.frame(name = c("East High School"), NCES_CODE = c("550852000925")) - -## walk boundary -walk_boundary_m <- 1.5 * 1609 - -## load school locations +## GeoPackage Data +```{r gpkg, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} WI_schools <- st_transform(st_read(dsn = "data/Schools/Wisconsin_Public_Schools_-5986231931870160084.gpkg"), crs = 4326) WI_schools <- WI_schools %>% mutate(geom = SHAPE) +``` -## load addresses +## Addresses Data + +```{r addresses, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} addresses <- read_csv(file="data/addresses/Addresses_Students_EastHS_2024_GeocodeResults.csv") %>% filter(lat > 0) %>% st_as_sf(coords=c("lon","lat"), crs=4326) # remember x=lon and y=lat +``` -## set osrm options +## Open Source Routing Machine (OSRM) + +```{r osrm, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} options(osrm.server = "http://127.0.0.1:5000/") options(osrm.profile = "walk") +``` +## Stadia Maps API Key + +```{r stadiamaps, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36)) +``` + +# Analysis + +## Subset Addresses Within 1.5 Miles + +```{r walkBoundary, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +walk_boundary_m <- 1.5 * 1609 ## walk boundary +school_focus <- data.frame(name = c("East High School"), NCES_CODE = c("550852000925")) ## school focus -## subset addresses within 1.5 miles walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance( loc = WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE), breaks = c(walk_boundary_m), @@ -59,8 +73,11 @@ walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance( ), units::set_units(1, km^2)) addresses_near <- st_intersection(addresses, walk_boundary_poly) +``` -## load bike tls +## Bike Level of Traffic Stress (LTS) + +```{r bikelts, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} bike_lts <- st_read("data/bike_lts/bike_lts_DANE.geojson") # make lts attribute a factor bike_lts[["lts"]] <- as.factor(bike_lts$LTS_F) @@ -74,6 +91,11 @@ bike_lts_scale <- data.frame(code = c(1, 2, 3, 4, 9), "#fdae61", "#d7191c", "#d7191c")) +``` + +## The Rest + +```{r therest, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ## calculate routes routes <- list(NULL) diff --git a/README.md b/README.md index 4d0610c..9471dc2 100644 --- a/README.md +++ b/README.md @@ -24,3 +24,6 @@ This script will generate a few figures: ## Using make The command `make route_analysis` will run *route_analysis.Rmd* which is an R markdown file containing the original R script *route_analysis.R* + +## Misc. +- [Bike Level of Traffic Stress (LTS)](https://www.dvrpc.org/webmaps/bike-lts/analysis/)