route_analysis/WI-schools-cycle.Rmd

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