Added descriptive text to WI-schools-cycle.Rmd

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")'

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()
 ```