update weight_streetnet.sc for bicycle routing #207

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dodgr
 Title: Distances on Directed Graphs
-Version: 0.2.20.003
+Version: 0.2.20.004
 Authors@R: c(
     person("Mark", "Padgham", , "mark.padgham@email.com", role = c("aut", "cre")),
     person("Andreas", "Petutschnig", role = "aut"),

R/graph-functions-misc.R

@@ -200,7 +200,9 @@ find_d_col <- function (graph) {
             tolower (substring (names (graph), 2, 2)) != "_"
     )
     if (length (d_col) != 1) {
-        d_col <- which (tolower (substring (names (graph), 1, 2)) == "di")
+        d_nms <- names (graph) [d_col]
+        d_col <- d_col [which (nchar (d_nms) == 1 |
+            tolower (substring (d_nms, 1L, 4L)) == "dist")]
     }
 
     if (length (d_col) != 1) {

R/weight-streetnet-times.R

@@ -66,9 +66,16 @@ extract_sc_edges_highways <- function (graph, x, wt_profile, wt_profile_file,
         keep_cols <- c (keep_cols, unique (surface$key))
     }
 
+    if (length (keep_cols) > 0L) {
+
+        keys <- unique (x$object$key)
+        keep_names <- lapply (keep_cols, function (i) grep (i, keys, value = TRUE))
+        keep_names <- sort (unique (unlist (keep_names)))
+    }
+
     graph <- dplyr::left_join (graph, x$object_link_edge, by = "edge_") %>%
         dplyr::select (-native_)
-    for (k in keep_cols) {
+    for (k in keep_names) {
         objs <- dplyr::filter (x$object, key == k)
         graph <- dplyr::left_join (graph, objs, by = "object_") %>%
             dplyr::rename (!!dplyr::quo_name (k) := value) %>%

R/weight-streetnet.R

@@ -582,6 +582,16 @@ weight_streetnet.sc <- function (x,
 
     x$vertex <- x$vertex [which (!duplicated (x$vertex)), ]
 
+    if (wt_profile == "bicycle") {
+        if (is.integer (keep_cols)) {
+            stop (
+                "keep_cols for 'sc' networks must be names of columns, not indices",
+                call. = FALSE
+            )
+        }
+        keep_cols <- unique (c (keep_cols, c ("^bicycle", "^cycleway")))
+    }
+
     graph <- extract_sc_edges_xy (x) %>% # vert, edge IDs + coordinates
         sc_edge_dist () %>% # append dist
         extract_sc_edges_highways (

codemeta.json

@@ -7,7 +7,7 @@
   "codeRepository": "https://github.com/ATFutures/dodgr",
   "issueTracker": "https://github.com/ATFutures/dodgr/issues",
   "license": "https://spdx.org/licenses/GPL-3.0",
-  "version": "0.2.20.003",
+  "version": "0.2.20.004",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",