From 7d7a9804004f4c5ec07f69a85698a8a9d90d7baf Mon Sep 17 00:00:00 2001
From: syounkin <syounkin@wisc.edu>
Date: Thu, 21 Nov 2024 11:32:27 -0600
Subject: [PATCH] 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             |   5 +-
 WI-schools-cycle.Rmd | 131 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 135 insertions(+), 1 deletion(-)
 create mode 100644 WI-schools-cycle.Rmd

diff --git a/Makefile b/Makefile
index d21affa..e69b36e 100644
--- a/Makefile
+++ b/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
 
diff --git a/WI-schools-cycle.Rmd b/WI-schools-cycle.Rmd
new file mode 100644
index 0000000..de4c0b7
--- /dev/null
+++ b/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()
+```