Merge pull request #16 from syounkin/sgy

Created an archive directory
create R/function.R
organize cycle_route_analysis_brouter.Rmd

.gitignore

@@ -15,8 +15,8 @@ data
 data-bkup/
 data-bkup
 *.R
+!R/functions.R
 *.bak
-archive/
 trash/
 api_key
 R/route_analysis.html

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

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)
+}

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

cycling_route_analysis_brouter.Rmd

@@ -31,6 +31,9 @@ library(jsonlite)
 library(parallel)
 fig.height <- 6
 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
@@ -173,6 +176,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}
@@ -186,56 +192,21 @@ 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&rsquo;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 functions, eval = runTLS, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
-getLTSForRoute <- function(i) {
+source("./R/functions.R")
-
+```
-  # 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)
-}
 
+```{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)
 
 # 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,
                        mc.cores = detectCores() / 2,
@@ -243,16 +214,21 @@ 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()
 
+
+# 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,
           aes(color = route$lts,
@@ -271,18 +247,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
-
-
-## 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}
 
@@ -382,8 +346,8 @@ ggsave(file = paste0("figures/",
        create.dir = TRUE)
 ```
 
-## Generate map of routes with LTS
+## Generate map of routes with LTS (1)
-```{r maprouteslts, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+```{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 ",
@@ -434,8 +398,9 @@ ggsave(file = paste0("figures/",
 
 ```
 
-## Generate map of routes with LTS
+## Generate map of routes with LTS (2)
-```{r mapaddresseslts, eval = TRUE, echo = FALSE, results = "show", warning = FALSE, error = TRUE, message = FALSE}
+
+```{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 ",
@@ -493,3 +458,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))
+
+```

docker/.gitignore

@@ -0,0 +1 @@
+archive/