Created WI-schools-cycle.Rmd

This script loops through WI schools and computes the cycling route from each grid cell to school. These routes and grids are saved to rds objects to be analyzed in a separate script.

Makefile

@@ -2,7 +2,7 @@ all: data containers cycle
 
 data: osrm-data brouter-data
 containers: osrm-container brouter-container
-cycle: route_to_school
+cycle: WI-schools-cycle
 
 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")'
@@ -16,6 +16,9 @@ cycle_brouter: cycling_route_analysis_brouter.Rmd
 route_to_school: route_to_school.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_to_school.Rmd", output_file = "./html/route_to_school.html")'
 
+WI-schools-cycle: WI-schools-cycle.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 = "./WI-schools-cycle.Rmd", output_file = "./html/WI-schools-cycle.html")'
+
 osrm-container: ./docker/osrm/docker-compose.yml
 	cd ./docker/osrm/; docker compose up -d
 

WI-schools-cycle.Rmd

@@ -0,0 +1,131 @@
+---
+title: "Wisconsin Cycling to School"
+output:
+  html_document:
+    toc: true
+    toc_depth: 5
+    toc_float:
+      collapsed: false
+      smooth_scroll: true
+editor_options:
+  chunk_output_type: console
+---
+
+# 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)
+fig.height <- 6
+set.seed(1)
+source("./R/functions.R")
+runLoop <- TRUE
+```
+## Configuration
+```{r config, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
+options(osrm.server = "http://127.0.0.1:5001/")
+options(osrm.profile = "bike")
+brouter_url <- "http://127.0.0.1:17777/brouter"
+brouter_profile <- "safety"
+register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36))
+WI_schools <- st_transform(st_read(dsn = "data/Schools/Wisconsin_Public_Schools_-5986231931870160084.gpkg"), crs = 4326)
+WI_schools <- WI_schools %>% mutate(geom = SHAPE)
+WI_schools <- subset(WI_schools, !is.na(LAT) & !is.na(LON) & GRADE_RANGE == "09-12")
+```
+## Loop through WI Schools
+```{r mainloop, eval = runLoop, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = TRUE}
+radius <- 3 # miles
+levels <- c(1)
+res <- 100
+threshold <- units::set_units(1, km^2)
+
+gridList <- list()
+routesList <- list()
+
+indexVec <- 1:nrow(WI_schools)
+
+for(j in indexVec){
+
+    school_location <- WI_schools[j,]
+
+    cycle_boundary_m <- radius*1609
+    cycle_boundary_poly <- osrmIsodistance( loc = school_location, breaks = cycle_boundary_m, res = res )
+    cycle_boundary_poly <- st_make_valid(cycle_boundary_poly)
+    cycle_boundary_poly <- fill_holes(cycle_boundary_poly, threshold)
+    cycle_boundary_poly <- st_transform(cycle_boundary_poly, crs = 4326)
+
+    cellsize <- 1e-2
+    grid <- st_make_grid(cycle_boundary_poly, cellsize = cellsize, what = "polygons", square = FALSE)
+    grid <- st_intersection(cycle_boundary_poly, grid)
+
+    grid <- st_make_valid(grid)
+
+    grid_pts <- st_centroid(grid)
+
+    grid_coods <- st_coordinates(grid_pts)
+    school_focus_location <- school_location %>% select(LAT, LON)
+
+    routes <- list(NULL)
+    for(i in 1:nrow(grid_coods) ) {
+        query <- paste0(
+            brouter_url,
+            "?lonlats=", grid_coods[i,1], ",",grid_coods[i,2], "|",
+            school_focus_location$LON, ",", school_focus_location$LAT,
+            "&profile=", brouter_profile,
+            "&alternativeidx=0&format=geojson"
+        )
+        response <- GET(query)
+
+        if( response$status_code == "200" ){
+            route_run <- st_read(content <- content(response, as = "text"), quiet = TRUE)
+            route_run[["student_number"]] <- i
+            routes[[i]] <- route_run
+        }else{
+            routes[[i]] <- NA
+        }
+    }
+
+    bad.cell <- which(is.na(routes))
+
+    if(length(bad.cell) > 0){
+        routes <- routes[-bad.cell]
+        grid <- grid[-bad.cell]
+    }
+
+
+    if(length(routes) > 0){
+        routes <- st_transform(bind_rows(routes), crs = 4326)
+    }else{
+        routes <- NA
+    }
+
+    gridList[[j]] <- grid
+    routesList[[j]] <- routes
+
+}
+
+saveRDS(gridList, "./R/data/gridList.rds")
+saveRDS(routesList, "./R/data/routesList.rds")
+```
+
+
+
+# Archive
+
+```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
+date()
+sessionInfo()
+```