lad regions

R/core_network.R

@@ -0,0 +1,102 @@
+core_network = function(os_scotland, osm_scotland, combined_network_tile, la_name, parameters, lads) {
+
+    sf::st_geometry(os_scotland) = "geometry"
+    sf::st_geometry(osm_scotland) = "geometry"
+
+    combined_net = combined_network_tile |>
+        sf::st_transform(crs = "EPSG:27700")
+
+    tryCatch(
+        {
+        la_name_boundary = filter(lads, LAD23NM == la_name) |>
+            sf::st_transform(crs = "EPSG:27700")
+
+        combined_net_la_name_boundary = combined_net[sf::st_union(la_name_boundary), , op = sf::st_intersects]
+
+        min_percentile_value = stats::quantile(combined_net_la_name_boundary$all_fastest_bicycle_go_dutch, probs = parameters$coherent_percentile[1], na.rm = TRUE)
+
+        os_scotland_la_name_boundary = os_scotland[sf::st_union(la_name_boundary), , op = sf::st_intersects]
+
+        os_combined_net_la_name_boundary = corenet::cohesive_network_prep(
+            base_network = os_scotland_la_name_boundary,
+            influence_network = combined_net_la_name_boundary,
+            la_name_boundary,
+            crs = "EPSG:27700",
+            key_attribute = "road_function",
+            attribute_values = c("A Road", "B Road", "Minor Road", "Local Road" , "Secondary Access Road" , "Local Access Road" )
+        )
+
+        cohesive_network_la_name_boundary = corenet::corenet(combined_net_la_name_boundary, os_combined_net_la_name_boundary, la_name_boundary,
+            key_attribute = "all_fastest_bicycle_go_dutch",
+            crs = "EPSG:27700", maxDistPts = 3000, minDistPts = 2, npt_threshold = min_percentile_value,
+            road_scores = list("A Road" = 1, "B Road" = 1, "Minor Road" = 100, "Local Road" = 100, "Secondary Access Road" = 100 , "Local Access Road" = 100), n_removeDangles = 6, penalty_value = 1, group_column = "name_1"
+        )
+
+        orcp_la_name_boundary = orcp_network(area = la_name_boundary, NPT_zones = combined_net_la_name_boundary, percentile_value = 0.7) 
+
+        if (!is.null(orcp_la_name_boundary) && nrow(orcp_la_name_boundary) > 0) {
+            osm_la_name = osm_scotland[sf::st_union(la_name_boundary), , op = sf::st_intersects] |> sf::st_transform(27700)
+            osm_la_name = osm_la_name[!is.na(osm_la_name$highway), ]
+
+            orcp_la_name_boundary = find_orcp_path(orcp_la_name_boundary, cohesive_network_la_name_boundary, osm_la_name, os_scotland_la_name_boundary, combined_net_la_name_boundary)
+
+            orcp_la_name_boundary = orcp_la_name_boundary |>
+            group_by(component) |>
+            summarize(
+                all_fastest_bicycle_go_dutch = round(mean(all_fastest_bicycle_go_dutch, na.rm = TRUE)),
+                geometry = st_line_merge(st_combine(st_union(geometry)))
+            )
+
+            p_90 = quantile(orcp_la_name_boundary$all_fastest_bicycle_go_dutch, 0.90, na.rm = TRUE)
+            p_25 = quantile(orcp_la_name_boundary$all_fastest_bicycle_go_dutch, 0.25, na.rm = TRUE)
+
+            # Update road function based on percentile thresholds
+            orcp_la_name_boundary$road_function = case_when(
+            orcp_la_name_boundary$all_fastest_bicycle_go_dutch > p_90 ~ "Primary",
+            orcp_la_name_boundary$all_fastest_bicycle_go_dutch > p_25 & orcp_la_name_boundary$all_fastest_bicycle_go_dutch <= p_90 ~ "Secondary",
+            orcp_la_name_boundary$all_fastest_bicycle_go_dutch <= p_25 ~ "Local Access",
+            TRUE ~ "Local Access"  
+            )
+
+            orcp_la_name_boundary$name_1 = orcp_la_name_boundary$component
+
+            # Identify common columns
+            common_columns = intersect(names(cohesive_network_la_name_boundary), names(orcp_la_name_boundary))
+
+            # Subset both data frames to common columns
+            cohesive_network_filtered = cohesive_network_la_name_boundary[common_columns]
+
+            cohesive_network_filtered = line_merge(cohesive_network_filtered, os_combined_net_la_name_boundary, combined_net_la_name_boundary, group_column = "name_1")
+
+            orcp_la_name_boundary_filtered = orcp_la_name_boundary[common_columns]
+
+            if (!is.null(cohesive_network_filtered) && nrow(cohesive_network_filtered) > 0) {
+            orcp_la_name_boundary_filtered = convert_to_linestrings(orcp_la_name_boundary_filtered)
+
+            grouped_network = rbind(cohesive_network_filtered, orcp_la_name_boundary_filtered)
+            } else {
+            grouped_network = orcp_la_name_boundary_filtered
+            }
+
+            # Remove duplicates in grouped_network
+            grouped_network = grouped_network[!duplicated(grouped_network), ]
+        } else {
+            grouped_network = cohesive_network_la_name_boundary
+        }
+
+        grouped_network = grouped_network |>
+            mutate(road_function = case_when(
+            road_function == "A Road" ~ "Primary",
+            road_function %in% c("B Road", "Minor Road") ~ "Secondary",
+            road_function %in% c("Local Road", "Local Access Road", "Secondary Access Road") ~ "Local Access",
+            TRUE ~ as.character(road_function)  # Keeps other values as they are
+            ))
+
+        message("Coherent network for: ", la_name, " generated successfully")
+        },
+        error = function(e) {
+        message(sprintf("An error occurred with %s: %s", la_name, e$message))    
+        }
+    )
+    corenetwork = grouped_network
+}

R/core_network_link.R

@@ -0,0 +1,67 @@
+core_network_link = function(os_scotland, osm_scotland, output_folder, date_folder) {
+
+  all_corenet_link = sf::st_sf(geometry = st_sfc()) 
+  st_crs(all_corenet_link) = 27700
+
+  lads = sf::read_sf("inputdata/boundaries/la_regions_2023.geojson")
+  region_names = unique(lads$Region)[c(3, 4, 1, 6, 2, 5)] |>
+    # Reverse to build smallest first:
+    rev()
+
+  cnet_path = file.path(output_folder, "combined_network_tile.geojson")
+  combined_net = sf::read_sf(cnet_path) |>
+    sf::st_transform(crs = "EPSG:27700")
+
+  # foreach(region = region_names) %dopar% {
+  for (region in region_names) {
+    message("Generating coherent network links for: ", region)
+    region_snake = snakecase::to_snake_case(region)
+
+    region_boundary = dplyr::filter(lads, Region == region) |>
+      sf::st_transform(crs = "EPSG:27700")
+
+    combined_net_region_boundary = combined_net[sf::st_union(region_boundary), , op = sf::st_intersects]
+
+    min_percentile_value = stats::quantile(combined_net_region_boundary$all_fastest_bicycle_go_dutch, probs = parameters$coherent_percentile[2], na.rm = TRUE)
+
+    os_scotland_region_boundary = os_scotland[sf::st_union(region_boundary), , op = sf::st_intersects]
+
+    os_combined_net_region_boundary = corenet::cohesive_network_prep(
+      base_network = os_scotland_region_boundary,
+      influence_network = combined_net_region_boundary,
+      region_boundary,
+      crs = "EPSG:27700",
+      key_attribute = "road_function",
+      attribute_values = c("A Road", "B Road")
+    )
+
+    os_combined_net_region_boundary = os_combined_net_region_boundary[os_combined_net_region_boundary$form_of_way != "Slip Road", ]
+
+    cohesive_network_region_boundary = corenet::corenet(combined_net_region_boundary, os_combined_net_region_boundary, region_boundary,
+      key_attribute = "all_fastest_bicycle_go_dutch",
+      crs = "EPSG:27700", maxDistPts = 15000, minDistPts = 1, npt_threshold = min_percentile_value,
+      road_scores = list("A Road" = 1, "B Road" = 1), n_removeDangles = 6, penalty_value = 100000, group_column = "name_1"
+    )
+
+    cohesive_network_region_boundary = line_merge(
+                    cohesive_network_region_boundary,
+                    os_combined_net_region_boundary,
+                    combined_net_region_boundary, 
+                    group_column = "name_1"
+                    ) 
+
+    cohesive_network_region_boundary = cohesive_network_region_boundary |> select(name_1, all_fastest_bicycle_go_dutch, geometry, road_function)
+
+    cohesive_network_region_boundary = cohesive_network_region_boundary |>
+      mutate(road_function = case_when(
+        road_function == "A Road" ~ "Primary",
+        road_function %in% c("B Road", "Minor Road") ~ "Secondary",
+        road_function %in% c("Local Road", "Local Access Road", "Secondary Access Road") ~ "Local Access",
+        TRUE ~ as.character(road_function)  # Keeps other values as they are
+      ))
+
+    all_corenet_link = rbind(all_corenet_link, cohesive_network_region_boundary)
+    message("Coherent network link for: ", region, " generated successfully")
+  }
+  corenet::create_coherent_network_PMtiles(folder_path = output_folder, city_filename = glue::glue("/combined_{date_folder}"), cohesive_network = all_corenet_link |> sf::st_transform(4326))
+}

R/get_routes.R

@@ -1,8 +1,21 @@
-get_routes = function(od, plans, purpose = "work", folder = ".", batch = TRUE, nrow_batch = 100, date = NULL, segments = TRUE, c2k = c("id", "distances", "quietness", "gradient_smooth")) {
+get_routes = function(
+  od,
+  plans,
+  purpose = "work",
+  folder = ".",
+  batch = TRUE,
+  nrow_batch = 100,
+  date = NULL,
+  segments = TRUE,
+  c2k = c("id", "distances", "quietness", "gradient_smooth"),
+  max_wait_time = 10
+  ) {
   if (nrow(od) < 50) {
     batch = FALSE
   }
   route_list = sapply(plans, function(x) NULL)
+  # For debugging:
+  plan = plans[1]
   for (plan in plans) {
     message("Getting the ", plan, " routes for ", purpose, " journeys")
     file_name = glue::glue("routes_{purpose}_{plan}.csv.gz")
@@ -24,13 +37,23 @@ get_routes = function(od, plans, purpose = "work", folder = ".", batch = TRUE, n
       #     id = 9905
       #   }
       # Add to database of saved routes:
-      p = jsonlite::read_json("parameters.json", simplifyVector = TRUE)
-      route_id_new = data.frame(nrow = nrow(od), plan = plan, purpose = purpose, region = p$region, date = p$date_routing)
+      route_id_new = data.frame(
+        nrow = nrow(od),
+        plan = plan,
+        purpose = purpose,
+        # Remove the first 23 characters from folder:
+        region = str_sub(folder, 23),
+        date = str_sub(folder, 12, 21)
+      )
       route_id_old = readr::read_csv("route_ids.csv")
       route_id_old$date = as.character(route_id_old$date)
       route_id = inner_join(route_id_new, route_id_old)
       if (nrow(route_id) == 0) {
         existing_route = FALSE
+        # Wait a random amount of time between 0 and 10 seconds to avoid overloading the server:
+        time_to_wait = runif(1, 0, max_wait_time)
+        message("Waiting for ", time_to_wait, " seconds")
+        Sys.sleep(time_to_wait)
         id = cyclestreets::batch(
           desire_lines = od,
           id = id,

R/simplify_network.R

@@ -2,15 +2,15 @@
 #' @param combined_network combined_network
 #' @param parameters parameters
 
-simplify_network = function(rnet_y, parameters, region_boundary) {
+simplify_network = function(rnet_y, la_name, la_boundary) {
   # Read spatial data directly from URLs into sf objects
-  # Build file path and URL based on parameters$region
-  region_snake_case = snakecase::to_snake_case(parameters$region[[1]])
+  # Build file path and URL based on parameters$local_authority
+  region_snake_case = snakecase::to_snake_case(la_name)
   base_name = paste0("OS_Scotland_Network_", region_snake_case, ".geojson")
   rnet_x_f = file.path("inputdata", base_name)
   rnet_x = sf::read_sf(rnet_x_f) |> sf::st_transform(crs = "EPSG:27700")
 
-  rnet_x = rnet_x[region_boundary |> sf::st_transform(crs = "EPSG:27700") , ] # TODO: is this needed? Can remove if not
+  rnet_x = rnet_x[la_boundary |> sf::st_transform(crs = "EPSG:27700") , ] # TODO: is this needed? Can remove if not
   rnet_xp = sf::st_transform(rnet_x, "EPSG:27700")
   rnet_yp = sf::st_transform(rnet_y, "EPSG:27700")