Merge pull request #17 from syounkin/sgy

Added Exploratory Code to Appendix
This commit is contained in:
bvarick 2024-11-11 10:48:02 -06:00 committed by GitHub
commit 39d86edb1a
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194

View File

@ -31,7 +31,7 @@ library(jsonlite)
library(parallel) library(parallel)
fig.height <- 6 fig.height <- 6
set.seed(1) set.seed(1)
runTLS <- TRUE runLTS <- FALSE
logo <- image_read(path = "other/BFW_Logo_180_x_200_transparent_background.png") logo <- image_read(path = "other/BFW_Logo_180_x_200_transparent_background.png")
school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.svg") school_symbol <- image_read_svg(path = "other/school_FILL0_wght400_GRAD0_opsz24.svg")
``` ```
@ -181,7 +181,7 @@ Notes:
## Combine routes with Bike LTS ## Combine routes with Bike LTS
```{r ltscount, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r ltscount, eval = runLTS, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# Count the routes that intersect or overlap with each segment of the bike_tls network. # Count the routes that intersect or overlap with each segment of the bike_tls network.
# The intersections have a buffer of 10m # The intersections have a buffer of 10m
@ -196,11 +196,11 @@ Notes:
- for each segment in bike_lts, this counts how many student&rsquo;s - for each segment in bike_lts, this counts how many student&rsquo;s
calculated routes intersect with it (within a 10 m buffer) calculated routes intersect with it (within a 10 m buffer)
```{r functions, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r functions, eval = runLTS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
source("./R/functions.R") source("./R/functions.R")
``` ```
```{r routeslts, eval = runTLS, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r routeslts, eval = runLTS, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# Start with routes_lts as a NULL list # Start with routes_lts as a NULL list
routes_lts <- list(NULL) routes_lts <- list(NULL)
@ -228,7 +228,7 @@ Notes:
## Generate map with LTS data ## Generate map with LTS data
```{r maplts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r maplts, eval = runLTS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
ggmap(basemap) + ggmap(basemap) +
geom_sf(data = routes_lts %>% filter(student_number == 6), inherit.aes = FALSE, geom_sf(data = routes_lts %>% filter(student_number == 6), inherit.aes = FALSE,
aes(color = route$lts, aes(color = route$lts,
@ -347,7 +347,7 @@ ggsave(file = paste0("figures/",
``` ```
## Generate map of routes with LTS (1) ## Generate map of routes with LTS (1)
```{r maprouteslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r maprouteslts, eval = runLTS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# generate map # generate map
ggmap(basemap) + ggmap(basemap) +
labs(title = paste0("Cycling routes for students at ", labs(title = paste0("Cycling routes for students at ",
@ -400,7 +400,7 @@ ggsave(file = paste0("figures/",
## Generate map of routes with LTS (2) ## Generate map of routes with LTS (2)
```{r mapaddresseslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ```{r mapaddresseslts, eval = runLTS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
# generate map # generate map
ggmap(basemap) + ggmap(basemap) +
labs(title = paste0("Level of Traffic stress for biking for students at ", labs(title = paste0("Level of Traffic stress for biking for students at ",
@ -454,6 +454,104 @@ ggsave(file = paste0("figures/",
# Appendix # Appendix
## Notes
### R Package sf
- Simple features or simple feature access refers to a formal standard
(ISO 19125-1:2004) that describes how objects in the real world can
be represented in computers, with emphasis on the spatial geometry
of these objects. It also describes how such objects can be stored
in and retrieved from databases, and which geometrical operations
should be defined for them.
- The standard is widely implemented in spatial databases (such as
PostGIS), commercial GIS (e.g., ESRI ArcGIS) and forms the vector
data basis for libraries such as GDAL. A subset of simple features
forms the GeoJSON standard.
- R has well-supported classes for storing spatial data (sp) and
interfacing to the above mentioned environments (rgdal, rgeos), but
has so far lacked a complete implementation of simple features,
making conversions at times convoluted, inefficient or
incomplete. The package sf tries to fill this gap, and aims at
succeeding sp in the long term.
- See source [here](https://r-spatial.github.io/sf/articles/sf1.html)
- all functions and methods in sf that operate on spatial data are
prefixed by st_, which refers to spatial type; this makes them
easily findable by command-line completion.
- Tessellation st_make_grid()
### Sandbox
#### Create a Grid Over Bikeable Area
```{r sandbox1, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
cellsize <- 5e-3
grid <- st_intersection(cycle_boundary_poly, st_make_grid(cycle_boundary_poly, cellsize = cellsize, what = "polygons", square = FALSE))
```
#### Compute Routes from Cell Centroid to School
```{r sandbox2, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
grid_pts <- st_centroid(grid)
grid_coods <- st_coordinates(grid_pts)
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)
route_run <- st_read(content <- content(response, as = "text"), quiet = TRUE)
route_run[["student_number"]] <- i
routes[[i]] <- route_run
}
routes <- st_transform(bind_rows(routes), crs = 4326)
```
Notes:
- What does `st_transform(bind_rows(routes), crs = 4326)` do?
#### Generate Map for Total Time
```{r sandbox3, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
track.length.vec <- routes %>% pull(track.length)
grid <- cbind(grid, track.length = as.numeric(track.length.vec)/1609)
total.time.vec <- routes %>% pull(total.time)
grid <- cbind(grid, total.time = as.numeric(total.time.vec)/60)
total.energy.vec <- routes %>% pull(total.energy)
grid <- cbind(grid, total.energy = as.numeric(total.energy.vec))
ggmap(basemap) +
geom_sf(data = grid,
aes(fill = total.time),
inherit.aes = FALSE
)
```
#### Available Route Data
```{r sandbox4, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
attributes(routes)$names
```
##### Message Data?
What information can we pull out of the messages data?
```{r sandbox5, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
routes[1,"messages"]
```
```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} ```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE}
date() date()
sessionInfo() sessionInfo()