Added descriptive text to WI-schools-cycle.Rmd
This commit is contained in:
parent
15656c9ca0
commit
d0eecdc2c5
3
Makefile
3
Makefile
@ -2,7 +2,8 @@ all: data containers cycle
|
|||||||
|
|
||||||
data: osrm-data brouter-data
|
data: osrm-data brouter-data
|
||||||
containers: osrm-container brouter-container
|
containers: osrm-container brouter-container
|
||||||
cycle: WI-schools-cycle
|
WI-cycle: WI-schools-cycle
|
||||||
|
cycle: cycle_brouter
|
||||||
|
|
||||||
walk: route_analysis.Rmd
|
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")'
|
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")'
|
||||||
|
@ -11,24 +11,20 @@ editor_options:
|
|||||||
chunk_output_type: console
|
chunk_output_type: console
|
||||||
---
|
---
|
||||||
|
|
||||||
|
```{r preCode, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
||||||
|
date()
|
||||||
|
```
|
||||||
|
|
||||||
# Input Data & Configuration
|
# Input Data & Configuration
|
||||||
|
|
||||||
## Libraries
|
## Libraries
|
||||||
|
|
||||||
```{r libs, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
```{r libs, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
|
||||||
date()
|
|
||||||
rm(list=ls())
|
rm(list=ls())
|
||||||
library(tidyverse)
|
library(tidyverse)
|
||||||
library(ggmap)
|
library(ggmap)
|
||||||
library(sf)
|
library(sf)
|
||||||
library(osrm)
|
library(osrm)
|
||||||
## library(smoothr)
|
|
||||||
## library(magick)
|
|
||||||
## library(ggnewscale)
|
|
||||||
## library(rsvg)
|
|
||||||
## library(httr)
|
|
||||||
## library(jsonlite)
|
|
||||||
## library(parallel)
|
|
||||||
library(reactable)
|
library(reactable)
|
||||||
fig.height <- 6
|
fig.height <- 6
|
||||||
set.seed(1)
|
set.seed(1)
|
||||||
@ -38,6 +34,8 @@ runLoop <- FALSE
|
|||||||
|
|
||||||
## Configuration
|
## Configuration
|
||||||
|
|
||||||
|
Set configuration parameters for OSRM, brouter, and stadiamaps.
|
||||||
|
|
||||||
```{r config, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
|
```{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.server = "http://127.0.0.1:5001/")
|
||||||
options(osrm.profile = "bike")
|
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)
|
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
|
## Subset Schools
|
||||||
|
|
||||||
```{r subsetSchools, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
|
```{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")
|
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
|
## 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}
|
```{r mainloop, eval = runLoop, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = TRUE}
|
||||||
radius <- 3 # miles
|
radius <- 3 # miles
|
||||||
levels <- c(1)
|
levels <- c(1)
|
||||||
@ -176,18 +190,31 @@ for(j in 1:length(gridList)){
|
|||||||
|
|
||||||
## Plot List Data
|
## 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
|
#### Histogram
|
||||||
median time on cycleway.
|
|
||||||
|
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
|
#### Longest
|
||||||
|
|
||||||
|
```{r worst, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = FALSE}
|
||||||
|
|
||||||
```{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()
|
|
||||||
|
|
||||||
register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36))
|
register_stadiamaps(key = substr(read_file(file = "api_keys/stadia_api_key"), 1, 36))
|
||||||
k <- 306
|
k <- 306
|
||||||
zoom.level <- 15
|
zoom.level <- 15
|
||||||
@ -207,7 +234,7 @@ The longest is `r WI_schools[k,] |> pull(SCHOOL)`.
|
|||||||
|
|
||||||
#### Shortest
|
#### 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
|
k <- 247
|
||||||
|
|
||||||
bbox <- st_bbox(st_buffer(gridList[[k]], dist = 500))
|
bbox <- st_bbox(st_buffer(gridList[[k]], dist = 500))
|
||||||
@ -224,7 +251,7 @@ The shortest is `r WI_schools[k,] |> pull(SCHOOL)`.
|
|||||||
|
|
||||||
### Statewide Map
|
### 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)
|
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
|
### 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}
|
```{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_table <- as.data.frame(cbind(WI_schools, not.cycleway.vec))
|
||||||
D <- select(D_table, SCHOOL, COUNTY, NONCYCLEWAY = not.cycleway.vec)
|
D <- select(D_table, SCHOOL, COUNTY, NONCYCLEWAY = not.cycleway.vec)
|
||||||
D <- D |> mutate(NONCYCLEWAY = round(NONCYCLEWAY,1))
|
D <- D |> mutate(NONCYCLEWAY = round(NONCYCLEWAY,1))
|
||||||
reactable(D)
|
reactable(D)
|
||||||
```
|
```
|
||||||
|
```{r date, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
|
||||||
|
date()
|
||||||
|
```
|
||||||
|
|
||||||
# Archive
|
# Archive
|
||||||
|
|
||||||
```{r chunklast, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
|
## Session Info
|
||||||
date()
|
```{r sessionInfo, eval = TRUE, echo = FALSE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
|
||||||
sessionInfo()
|
sessionInfo()
|
||||||
```
|
```
|
||||||
|
Loading…
x
Reference in New Issue
Block a user