From dfe33b953f72856775abe31114a49c2f32192dc1 Mon Sep 17 00:00:00 2001 From: syounkin Date: Fri, 8 Nov 2024 12:45:36 -0600 Subject: [PATCH 1/2] Added Exploratory Code to Appendix Trying to get route-level statistics plotted over a grid. --- cycling_route_analysis_brouter.Rmd | 97 +++++++++++++++++++++++++++--- 1 file changed, 90 insertions(+), 7 deletions(-) diff --git a/cycling_route_analysis_brouter.Rmd b/cycling_route_analysis_brouter.Rmd index 8934fad..dcecb6c 100644 --- a/cycling_route_analysis_brouter.Rmd +++ b/cycling_route_analysis_brouter.Rmd @@ -31,7 +31,7 @@ library(jsonlite) library(parallel) fig.height <- 6 set.seed(1) -runTLS <- TRUE +runLTS <- FALSE 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") ``` @@ -181,7 +181,7 @@ Notes: ## 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. # The intersections have a buffer of 10m @@ -196,11 +196,11 @@ Notes: - for each segment in bike_lts, this counts how many student’s 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") ``` -```{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 routes_lts <- list(NULL) @@ -228,7 +228,7 @@ Notes: ## 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) + geom_sf(data = routes_lts %>% filter(student_number == 6), inherit.aes = FALSE, aes(color = route$lts, @@ -347,7 +347,7 @@ ggsave(file = paste0("figures/", ``` ## 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 ggmap(basemap) + labs(title = paste0("Cycling routes for students at ", @@ -400,7 +400,7 @@ ggsave(file = paste0("figures/", ## 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 ggmap(basemap) + labs(title = paste0("Level of Traffic stress for biking for students at ", @@ -454,6 +454,89 @@ ggsave(file = paste0("figures/", # 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)) + +ggmap(basemap) + + geom_sf(data = st_geometry(grid), + inherit.aes = FALSE, + fill = NA, + linewidth = 0.5) +``` + +#### Compute Routes from 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) + +ggmap(basemap) + + geom_sf(data = st_geometry(routes), + inherit.aes = FALSE, + fill = NA, + linewidth = 0.5, + color = "red" + ) + + geom_sf(data = st_geometry(grid), + inherit.aes = FALSE, + fill = NA, + linewidth = 0.5) +``` + +#### Compute Route-Level Measures + +How do we retireve features of the route such as percentage on +cycleway? My next step is to look over getLTSForRoute() for tips. + ```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} date() sessionInfo() From 46f67bb15f55d439447d18e1aa11a574af850e5e Mon Sep 17 00:00:00 2001 From: syounkin Date: Fri, 8 Nov 2024 14:13:28 -0600 Subject: [PATCH 2/2] Update to New Code in the Appendix --- cycling_route_analysis_brouter.Rmd | 57 +++++++++++++++++++----------- 1 file changed, 36 insertions(+), 21 deletions(-) diff --git a/cycling_route_analysis_brouter.Rmd b/cycling_route_analysis_brouter.Rmd index dcecb6c..7f6cd8f 100644 --- a/cycling_route_analysis_brouter.Rmd +++ b/cycling_route_analysis_brouter.Rmd @@ -488,21 +488,15 @@ ggsave(file = paste0("figures/", cellsize <- 5e-3 grid <- st_intersection(cycle_boundary_poly, st_make_grid(cycle_boundary_poly, cellsize = cellsize, what = "polygons", square = FALSE)) - -ggmap(basemap) + - geom_sf(data = st_geometry(grid), - inherit.aes = FALSE, - fill = NA, - linewidth = 0.5) ``` -#### Compute Routes from Centroid to School +#### 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) +routes <- list(NULL) for(i in 1:nrow(grid_coods) ) { query <- paste0( brouter_url, @@ -518,24 +512,45 @@ for(i in 1:nrow(grid_coods) ) { } 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 = st_geometry(routes), - inherit.aes = FALSE, - fill = NA, - linewidth = 0.5, - color = "red" - ) + - geom_sf(data = st_geometry(grid), - inherit.aes = FALSE, - fill = NA, - linewidth = 0.5) + geom_sf(data = grid, + aes(fill = total.time), + inherit.aes = FALSE + ) ``` -#### Compute Route-Level Measures +#### 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"] +``` -How do we retireve features of the route such as percentage on -cycleway? My next step is to look over getLTSForRoute() for tips. ```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} date()