From ba5c5c9c29cecbb81004c6ec18ec368328726611 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 10:28:42 -0600 Subject: [PATCH 1/9] Created runTLS flag runTLS is a boolean variable that controls whether the ltscount chunk is evaluated --- cycling_route_analysis_brouter.Rmd | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/cycling_route_analysis_brouter.Rmd b/cycling_route_analysis_brouter.Rmd index feff52c..bc840c3 100644 --- a/cycling_route_analysis_brouter.Rmd +++ b/cycling_route_analysis_brouter.Rmd @@ -30,6 +30,7 @@ library(httr) library(jsonlite) library(parallel) fig.height <- 6 +runTLS <- FALSE set.seed(1) ``` @@ -186,9 +187,9 @@ bike_lts_buffer["student_use"] <- unlist(lapply(st_intersects(bike_lts_buffer, r bike_lts <- left_join(bike_lts, as.data.frame(bike_lts_buffer %>% select(OBJECTID, student_use)), by = "OBJECTID") ``` -Notes: for each segment in bike_lts, this counts how many student's calculated routes intersect with it (within a 10 m buffer) +Notes: for each segment in bike_lts, this counts how many student’s calculated routes intersect with it (within a 10 m buffer) -```{r routeslts, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +```{r routeslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} getLTSForRoute <- function(i) { # Filter the routes for the current student number From 372d765f2fb863c9d47de526402d9360a57371e8 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 10:29:55 -0600 Subject: [PATCH 2/9] Created archive directory Moved cycling_route_analysis.Rmd to archive/ --- .gitignore | 1 - archive/.gitignore | 10 ++++++++++ .../cycling_route_analysis.Rmd | 0 docker/.gitignore | 1 + 4 files changed, 11 insertions(+), 1 deletion(-) create mode 100644 archive/.gitignore rename cycling_route_analysis.Rmd => archive/cycling_route_analysis.Rmd (100%) create mode 100644 docker/.gitignore diff --git a/.gitignore b/.gitignore index da4a557..89b31d2 100644 --- a/.gitignore +++ b/.gitignore @@ -16,7 +16,6 @@ data-bkup/ data-bkup *.R *.bak -archive/ trash/ api_key R/route_analysis.html diff --git a/archive/.gitignore b/archive/.gitignore new file mode 100644 index 0000000..5044ea6 --- /dev/null +++ b/archive/.gitignore @@ -0,0 +1,10 @@ +# Ignore everything in this directory +* +# Except this file +!.gitignore +!docker-compose.yml +!docker-compose-2.yml +!preprocess.sh +!data-raw/ +!data-foot/ +!data-bicycle/ diff --git a/cycling_route_analysis.Rmd b/archive/cycling_route_analysis.Rmd similarity index 100% rename from cycling_route_analysis.Rmd rename to archive/cycling_route_analysis.Rmd diff --git a/docker/.gitignore b/docker/.gitignore new file mode 100644 index 0000000..8b77f12 --- /dev/null +++ b/docker/.gitignore @@ -0,0 +1 @@ +archive/ \ No newline at end of file From dde9ece09fca82837103cd85fe2729ea02b66c6f Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 12:01:03 -0600 Subject: [PATCH 3/9] Update to Makefile --- Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/Makefile b/Makefile index df59fdb..ee206b4 100644 --- a/Makefile +++ b/Makefile @@ -29,10 +29,10 @@ brouter-container: ./docker/brouter/docker-compose.yml cd ./docker/brouter; docker compose up -d brouter-data: - cd ./docker/brouter/; rm -rf ./brouter; git clone https://github.com/abrensch/brouter.git + cd ./docker/brouter/; rm -rf ./brouter-bkup/; mv -v ./brouter/ ./brouter-bkup/; git clone https://github.com/abrensch/brouter.git cd ./docker/brouter/; wget -i segments.csv -P ./brouter/misc/segments4/ cd ./docker/brouter/; cp safety.brf ./brouter/misc/profiles2/safety.brf - cd ./docker/brouter/; rm -rf ./brouter-web; git clone https://github.com/nrenner/brouter-web.git + cd ./docker/brouter/; rm -rf ./brouter-web-bkup/; mv -v ./brouter-web/ ./brouter-web-bkup/; git clone https://github.com/nrenner/brouter-web.git cd ./docker/brouter/brouter-web; cp keys.template.js keys.js; cd ./docker/brouter/brouter-web; cp config.template.js config.js cd ./docker/brouter; docker compose build From ecd62d5a3cad571bd134742268f7cf1aece46c19 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 12:08:30 -0600 Subject: [PATCH 4/9] Correction to archive/.gitignore --- archive/.gitignore | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/archive/.gitignore b/archive/.gitignore index 5044ea6..a3d40c6 100644 --- a/archive/.gitignore +++ b/archive/.gitignore @@ -2,9 +2,4 @@ * # Except this file !.gitignore -!docker-compose.yml -!docker-compose-2.yml -!preprocess.sh -!data-raw/ -!data-foot/ -!data-bicycle/ +!cycling_route_analysis.Rmd From fda6ee6d955bd6bc95a3a3ad6946deb15ad2fa84 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 12:11:03 -0600 Subject: [PATCH 5/9] Removed archive/.gitignore --- archive/.gitignore | 5 ----- 1 file changed, 5 deletions(-) delete mode 100644 archive/.gitignore diff --git a/archive/.gitignore b/archive/.gitignore deleted file mode 100644 index a3d40c6..0000000 --- a/archive/.gitignore +++ /dev/null @@ -1,5 +0,0 @@ -# Ignore everything in this directory -* -# Except this file -!.gitignore -!cycling_route_analysis.Rmd From 34fa374de50277dda3d86ca3afc6c45ac2e20d9f Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 12:23:08 -0600 Subject: [PATCH 6/9] Added cycling_route_analysis.Rmd to archive/ --- archive/cycling_route_analysis.Rmd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/archive/cycling_route_analysis.Rmd b/archive/cycling_route_analysis.Rmd index 7116a91..b16f73c 100644 --- a/archive/cycling_route_analysis.Rmd +++ b/archive/cycling_route_analysis.Rmd @@ -16,6 +16,7 @@ editor_options: ## Libraries ```{r libs, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +#foo date() rm(list=ls()) library(tidyverse) @@ -328,6 +329,8 @@ ggsave(file = paste0("figures/", # Appendix +This script has been moved to ./archive/. + ```{r chunklast, eval = TRUE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} date() sessionInfo() From 41d87517d83f9b593a6d280c9baedb109fe79de5 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 12:43:30 -0600 Subject: [PATCH 7/9] Organized cycle_route_analysis_brouter.Rmd Added some notes. Divided up some chunks. --- cycling_route_analysis_brouter.Rmd | 113 +++++++++++++---------------- 1 file changed, 49 insertions(+), 64 deletions(-) diff --git a/cycling_route_analysis_brouter.Rmd b/cycling_route_analysis_brouter.Rmd index bc840c3..b21ab1f 100644 --- a/cycling_route_analysis_brouter.Rmd +++ b/cycling_route_analysis_brouter.Rmd @@ -139,10 +139,10 @@ routes <- list(NULL) school_focus_location <- WI_schools %>% filter(NCES_CODE %in% school_focus$NCES_CODE) %>% select(LAT, LON) for(i in addresses_near %>% arrange(number) %>% pull(number)) { query <- paste0( - brouter_url, + brouter_url, "?lonlats=", - (addresses_near %>% filter(number == i) %>% pull(point) %>% str_split(., ","))[[1]][1], ",", - (addresses_near %>% filter(number == i) %>% pull(point) %>% str_split(., ","))[[1]][2], "|", + (addresses_near %>% filter(number == i) %>% pull(point) %>% str_split(., ","))[[1]][1], ",", + (addresses_near %>% filter(number == i) %>% pull(point) %>% str_split(., ","))[[1]][2], "|", school_focus_location$LON, ",", school_focus_location$LAT, "&profile=", brouter_profile, "&alternativeidx=0&format=geojson" @@ -151,8 +151,8 @@ for(i in addresses_near %>% arrange(number) %>% pull(number)) { route_run <- st_read(content <- content(response, as = "text"), quiet = TRUE) route_run[["student_number"]] <- i routes[[i]] <- route_run - - + + message(paste0("done - ", i, " of ", max(addresses_near$number))) } @@ -174,6 +174,9 @@ bbox <- c(left = as.double(bbox[1]), #get basemap basemap <- get_stadiamap(bbox = bbox, zoom = 15, maptype = "stamen_toner_lite") ``` +Notes: +- This chunk retrieves the base map from Stadia Maps (API key required) + ## Combine routes with Bike LTS ```{r ltscount, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} @@ -187,55 +190,20 @@ bike_lts_buffer["student_use"] <- unlist(lapply(st_intersects(bike_lts_buffer, r bike_lts <- left_join(bike_lts, as.data.frame(bike_lts_buffer %>% select(OBJECTID, student_use)), by = "OBJECTID") ``` -Notes: for each segment in bike_lts, this counts how many student’s calculated routes intersect with it (within a 10 m buffer) +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} +source("./R/functions.R") +``` ```{r routeslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} -getLTSForRoute <- function(i) { - - # Filter the routes for the current student number - current_route <- routes %>% filter(student_number == i) - - # Find intersecting OBJECTIDs - intersecting_ids <- relevant_buffer$OBJECTID[lengths(st_intersects(relevant_buffer, current_route)) > 0] - - # Filter relevant segments to calculate max and average lts - relevant_segments <- bike_lts_buffer %>% filter(OBJECTID %in% intersecting_ids) - - # find all the segments of relevant_buffer that the current route passes through - current_route_lts_intersection <- st_intersection(current_route, relevant_segments) - - # calculate segment length in meters - current_route_lts_intersection$"segment_length" <- as.double(st_length(current_route_lts_intersection)) - - # Return the result as a list - result <- list( - student_number = i - , lts_max = max(current_route_lts_intersection$LTS_F) - , lts_average = weighted.mean(current_route_lts_intersection$LTS_F, current_route_lts_intersection$segment_length) - , lts_1_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 1) %>% pull(LTS_F)) - , lts_2_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 2) %>% pull(LTS_F)) - , lts_3_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 3) %>% pull(LTS_F)) - , lts_4_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 4) %>% pull(LTS_F)) - , route = as.data.frame(current_route_lts_intersection) - ) - - # Message for progress - message(paste0("done - ", i)) - - return(result) -} - # Start with routes_lts as a NULL list routes_lts <- list(NULL) # Pre-filter the bike_lts_buffer for relevant student use relevant_buffer <- bike_lts_buffer %>% filter(student_use > 0) - -# routes_lts <- lapply(head(addresses_near %>% arrange(number) %>% pull(number)), -# getLTSForRoute) - -# system.time(routes_lts <- lapply(head(addresses_near %>% arrange(number) %>% pull(number)), -# getLTSForRoute)) routes_lts <- mclapply(addresses_near %>% arrange(number) %>% pull(number), getLTSForRoute, @@ -244,27 +212,27 @@ routes_lts <- mclapply(addresses_near %>% arrange(number) %>% pull(number), mc.preschedule = TRUE, mc.silent = FALSE) -# for(i in addresses_near %>% arrange(number) %>% pull(number)) { -# lts_segments <- bike_lts_buffer$OBJECTID[st_intersects(bike_lts_buffer, routes %>% filter(student_number == i), sparse = FALSE)] -# lts_max <- max(bike_lts_buffer %>% filter(OBJECTID %in% lts_segments) %>% pull(LTS_F), na.rm = TRUE) -# lts_average <- mean(bike_lts_buffer %>% filter(OBJECTID %in% lts_segments) %>% pull(LTS_F), na.rm = TRUE) -# routes_lts[[i]] <- data.frame("student_number" = c(i), "lts_max" = c(lts_max), "lts_average" = c(lts_average)) -# message(paste0("done - ", i, " of ", max(addresses_near$number))) -# } - routes_lts <- bind_rows(routes_lts) +``` +Notes: +- for each student's route, this finds which bike_lts segment it + intersects with and calculates a max and an average level of traffic + stress (LTS). This takes a while, so a parallelized it. There's + probably a more efficient way to do this calculation. +- see ./R/functions.R for defintion of getLTSForRoute() -ggmap(basemap) + - geom_sf(data = routes_lts %>% filter(student_number == 6), inherit.aes = FALSE, - aes(color = route$lts, +```{r maplts, eval = runTLS, 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, geometry = route$geometry), - linewidth = 2) + + linewidth = 2) + scale_color_manual(values = bike_lts_scale$color, name = "Bike Level of Traffic Stress") # Join the data with the addresses data -addresses_near <- left_join(addresses_near, - routes_lts %>% - select(c("student_number", "lts_max", "lts_average", "lts_1_dist", "lts_2_dist", "lts_3_dist", "lts_4_dist")), +addresses_near <- left_join(addresses_near, + routes_lts %>% + select(c("student_number", "lts_max", "lts_average", "lts_1_dist", "lts_2_dist", "lts_3_dist", "lts_4_dist")), join_by("number"=="student_number"), multiple = "any") @@ -272,8 +240,6 @@ addresses_near <- left_join(addresses_near, addresses_near <- addresses_near %>% mutate(lts_34_dist = lts_3_dist + lts_4_dist) ``` -Notes: for each student's route, this finds which bike_lts segment it intersects with and calculates a max and an average level of traffic stress (LTS). This takes a while, so a parallelized it. There's probably a more efficient way to do this calculation. - # Make Maps @@ -494,3 +460,22 @@ ggsave(file = paste0("figures/", date() sessionInfo() ``` + +# Archive + +```{r archive1, eval = FALSE, echo = TRUE, results = "show", warning = TRUE, error = TRUE, message = TRUE} +# for(i in addresses_near %>% arrange(number) %>% pull(number)) { +# lts_segments <- bike_lts_buffer$OBJECTID[st_intersects(bike_lts_buffer, routes %>% filter(student_number == i), sparse = FALSE)] +# lts_max <- max(bike_lts_buffer %>% filter(OBJECTID %in% lts_segments) %>% pull(LTS_F), na.rm = TRUE) +# lts_average <- mean(bike_lts_buffer %>% filter(OBJECTID %in% lts_segments) %>% pull(LTS_F), na.rm = TRUE) +# routes_lts[[i]] <- data.frame("student_number" = c(i), "lts_max" = c(lts_max), "lts_average" = c(lts_average)) +# message(paste0("done - ", i, " of ", max(addresses_near$number))) +# } + +# routes_lts <- lapply(head(addresses_near %>% arrange(number) %>% pull(number)), +# getLTSForRoute) + +# system.time(routes_lts <- lapply(head(addresses_near %>% arrange(number) %>% pull(number)), +# getLTSForRoute)) + +``` From 1843fd3e4491e7b9db5929a54dee544ee7d286c5 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 13:37:00 -0600 Subject: [PATCH 8/9] More Organization of cycle_route_analysis_brouter.Rmd --- cycling_route_analysis_brouter.Rmd | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/cycling_route_analysis_brouter.Rmd b/cycling_route_analysis_brouter.Rmd index b21ab1f..8934fad 100644 --- a/cycling_route_analysis_brouter.Rmd +++ b/cycling_route_analysis_brouter.Rmd @@ -30,8 +30,10 @@ library(httr) library(jsonlite) library(parallel) fig.height <- 6 -runTLS <- FALSE set.seed(1) +runTLS <- TRUE +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 Location Data @@ -198,7 +200,7 @@ Notes: source("./R/functions.R") ``` -```{r routeslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +```{r routeslts, eval = runTLS, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} # Start with routes_lts as a NULL list routes_lts <- list(NULL) @@ -221,6 +223,11 @@ Notes: probably a more efficient way to do this calculation. - see ./R/functions.R for defintion of getLTSForRoute() + +# Make Maps + +## Generate map with LTS data + ```{r maplts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} ggmap(basemap) + geom_sf(data = routes_lts %>% filter(student_number == 6), inherit.aes = FALSE, @@ -240,16 +247,6 @@ addresses_near <- left_join(addresses_near, addresses_near <- addresses_near %>% mutate(lts_34_dist = lts_3_dist + lts_4_dist) ``` -# Make Maps - - -## Load school and Bike Fed logo -```{r logos, eval = TRUE, echo = TRUE, results = "show", warning = FALSE, error = TRUE, message = FALSE} -# load logo -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") -``` - ## Generate map of addresses ```{r mapaddresses, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} @@ -349,8 +346,8 @@ ggsave(file = paste0("figures/", create.dir = TRUE) ``` -## Generate map of routes with LTS -```{r maprouteslts, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +## Generate map of routes with LTS (1) +```{r maprouteslts, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} # generate map ggmap(basemap) + labs(title = paste0("Cycling routes for students at ", @@ -401,8 +398,9 @@ ggsave(file = paste0("figures/", ``` -## Generate map of routes with LTS -```{r mapaddresseslts, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE} +## Generate map of routes with LTS (2) + +```{r mapaddresseslts, eval = runTLS, 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 ", From 57b46664ef85611cd37da8bef37541a75df88ef2 Mon Sep 17 00:00:00 2001 From: syounkin Date: Thu, 7 Nov 2024 13:40:00 -0600 Subject: [PATCH 9/9] Stopped ignoring functions.R --- .gitignore | 1 + R/functions.R | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) create mode 100644 R/functions.R diff --git a/.gitignore b/.gitignore index 89b31d2..4838c57 100644 --- a/.gitignore +++ b/.gitignore @@ -15,6 +15,7 @@ data data-bkup/ data-bkup *.R +!R/functions.R *.bak trash/ api_key diff --git a/R/functions.R b/R/functions.R new file mode 100644 index 0000000..c24604a --- /dev/null +++ b/R/functions.R @@ -0,0 +1,34 @@ +getLTSForRoute <- function(i) { + + # Filter the routes for the current student number + current_route <- routes %>% filter(student_number == i) + + # Find intersecting OBJECTIDs + intersecting_ids <- relevant_buffer$OBJECTID[lengths(st_intersects(relevant_buffer, current_route)) > 0] + + # Filter relevant segments to calculate max and average lts + relevant_segments <- bike_lts_buffer %>% filter(OBJECTID %in% intersecting_ids) + + # find all the segments of relevant_buffer that the current route passes through + current_route_lts_intersection <- st_intersection(current_route, relevant_segments) + + # calculate segment length in meters + current_route_lts_intersection$"segment_length" <- as.double(st_length(current_route_lts_intersection)) + + # Return the result as a list + result <- list( + student_number = i + , lts_max = max(current_route_lts_intersection$LTS_F) + , lts_average = weighted.mean(current_route_lts_intersection$LTS_F, current_route_lts_intersection$segment_length) + , lts_1_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 1) %>% pull(LTS_F)) + , lts_2_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 2) %>% pull(LTS_F)) + , lts_3_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 3) %>% pull(LTS_F)) + , lts_4_dist = sum(current_route_lts_intersection %>% filter(LTS_F == 4) %>% pull(LTS_F)) + , route = as.data.frame(current_route_lts_intersection) + ) + + # Message for progress + message(paste0("done - ", i)) + + return(result) +}