diff --git a/Makefile b/Makefile index e69b36e..eb42337 100644 --- a/Makefile +++ b/Makefile @@ -2,7 +2,8 @@ all: data containers cycle data: osrm-data brouter-data containers: osrm-container brouter-container -cycle: WI-schools-cycle +WI-cycle: WI-schools-cycle +cycle: cycle_brouter walk: route_analysis.Rmd R -e 'library("rmarkdown"); old_path <- Sys.getenv("PATH"); Sys.setenv(PATH = paste(old_path, "/usr/local/bin", sep = ":")); rmarkdown::render(knit_root_dir = "./", output_dir = "./html", input = "./route_analysis.Rmd", output_file = "./html/route_analysis.html")' diff --git a/WI-schools-cycle.Rmd b/WI-schools-cycle.Rmd index b2c76aa..b7971a5 100644 --- a/WI-schools-cycle.Rmd +++ b/WI-schools-cycle.Rmd @@ -11,24 +11,20 @@ editor_options: chunk_output_type: console --- +```{r preCode, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +date() +``` + # Input Data & Configuration ## Libraries ```{r libs, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} -date() rm(list=ls()) library(tidyverse) library(ggmap) library(sf) library(osrm) -## library(smoothr) -## library(magick) -## library(ggnewscale) -## library(rsvg) -## library(httr) -## library(jsonlite) -## library(parallel) library(reactable) fig.height <- 6 set.seed(1) @@ -38,6 +34,8 @@ runLoop <- FALSE ## Configuration +Set configuration parameters for OSRM, brouter, and stadiamaps. + ```{r config, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} options(osrm.server = "http://127.0.0.1:5001/") options(osrm.profile = "bike") @@ -48,16 +46,32 @@ WI_schools <- st_transform(st_read(dsn = "data/Schools/Wisconsin_Public_Schools_ WI_schools <- WI_schools %>% mutate(geom = SHAPE) ``` +# Analysis + +We focus on the statistic *non-cycleway duration* in this analysis. It +is computed as the duration (in minutes) of the bike trip to school +(brouter, safety) for each grid cell in the school's bikeable +area. A bikeable area is defined as the region within 3 miles of +school by bike (OSRM). + ## Subset Schools ```{r subsetSchools, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} WI_schools <- subset(WI_schools, !is.na(LAT) & !is.na(LON) & GRADE_RANGE == "09-12") ``` -Non-virtual, grades 9-12. +We keep only schools with coordinates (non-virtual) and, for +simplicity and efficiency of the initial analysis, we keep only +schools with grades 9-12. ## Loop through WI Schools +For each school we compute the grid and the routes sf objects and save +them as lists as R data files, _gridList.rds_ and +_routesList.rds_. These will then be analyzed downstream and this loop +need not be run again. It took around 40 minutes to run. The code here +is suppressed because it is long and ugly. + ```{r mainloop, eval = runLoop, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = TRUE} radius <- 3 # miles levels <- c(1) @@ -176,18 +190,31 @@ for(j in 1:length(gridList)){ ## Plot List Data -### Shortest and Longest Median Non-Cycleway Duration +### Median Non-Cycleway Duration -First we take a look at the schools with the shortest and longest -median time on cycleway. +#### Histogram + +First we investigate the distribution of median non-cycleway duration +across school. Recall that we are considering now only schools grade +9-12. + +```{r hist, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +ggplot(data.frame(not.cycleway = not.cycleway.vec), aes(not.cycleway)) + geom_histogram(fill = "orange", color = "black") + theme_bw() +``` + +Next, we take a look at the schools with the shortest and longest +median time on cycleway. Note that the analysis is peformed across a +gridded area and not with respect to where students live. The median +non-cycleway duration is computed across grid cells, not students. + +Note too that this statistics was computed by parsing the *messages* +field of the route returned by brouter. I am not sure if there is a +better way to do this. Within the messages field there is information +on highway type, surface, etc for each segment of the route. #### Longest - - -```{r worst, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} -ggplot(data.frame(not.cycleway = not.cycleway.vec), aes(not.cycleway)) + geom_histogram(fill = "grey", color = "black") + theme_bw() - +```{r worst, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = FALSE} register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36)) k <- 306 zoom.level <- 15 @@ -207,7 +234,7 @@ The longest is `r WI_schools[k,] |> pull(SCHOOL)`. #### Shortest -```{r best, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} +```{r best, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = FALSE} k <- 247 bbox <- st_bbox(st_buffer(gridList[[k]], dist = 500)) @@ -224,7 +251,7 @@ The shortest is `r WI_schools[k,] |> pull(SCHOOL)`. ### Statewide Map -```{r plots2, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} +```{r plots2, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = FALSE} D <- cbind(WI_schools, not.cycleway.vec) @@ -243,16 +270,21 @@ ggmap(basemap) + geom_sf(data = D, aes(size = 2, color = not.cycleway.vec), inhe ### Statewide Table +The values shown above can be seen below in this clickable table. + ```{r table, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} D_table <- as.data.frame(cbind(WI_schools, not.cycleway.vec)) D <- select(D_table, SCHOOL, COUNTY, NONCYCLEWAY = not.cycleway.vec) D <- D |> mutate(NONCYCLEWAY = round(NONCYCLEWAY,1)) reactable(D) ``` +```{r date, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} +date() +``` # Archive -```{r chunklast, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} -date() +## Session Info +```{r sessionInfo, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE} sessionInfo() ```