diff --git a/R/route_analysis.Rmd b/R/route_analysis.Rmd index c9d287c..53d4bed 100644 --- a/R/route_analysis.Rmd +++ b/R/route_analysis.Rmd @@ -1,5 +1,5 @@ --- -title: "East High Active Travel" +title: "Route Analysis" output: html_document: toc: true @@ -11,10 +11,6 @@ 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()) @@ -30,42 +26,32 @@ fig.height <- 6 set.seed(1) ``` -## GeoPackage Data +# 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 -```{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) -``` -## Addresses Data - -```{r addresses, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +## load addresses 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 -``` -## Open Source Routing Machine (OSRM) - -```{r osrm, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +## set osrm options 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), @@ -73,11 +59,8 @@ walk_boundary_poly <- fill_holes(st_make_valid(osrmIsodistance( ), units::set_units(1, km^2)) addresses_near <- st_intersection(addresses, walk_boundary_poly) -``` -## Bike Level of Traffic Stress (LTS) - -```{r bikelts, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +## load bike tls 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) @@ -91,11 +74,6 @@ 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 9471dc2..4d0610c 100644 --- a/README.md +++ b/README.md @@ -24,6 +24,3 @@ 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/)