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