diff --git a/DESCRIPTION b/DESCRIPTION index 45d6df7..4b05c43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: utaengine Title: Routing and aggregation engine for 'Urban Transport Analyst' -Version: 0.1.0.122 +Version: 0.1.0.123 Authors@R: person(given = "Mark", family = "Padgham", diff --git a/R/bicycle-infrastructure.R b/R/bicycle-infrastructure.R index 5a45ec5..8806e98 100644 --- a/R/bicycle-infrastructure.R +++ b/R/bicycle-infrastructure.R @@ -26,9 +26,15 @@ add_bike_infrastructure <- function (s, city, dlimit = 5000) { "track", "yes" ) - net$edge_type [net$cycleway %in% cycleway_types] <- "full" - net$edge_type [net$`cycleway:left` %in% cycleway_types] <- "full" - net$edge_type [net$`cycleway:right` %in% cycleway_types] <- "full" + if ("cycleway" %in% names (net)) { + net$edge_type [net$cycleway %in% cycleway_types] <- "full" + } + if ("cycleway:left" %in% names (net)) { + net$edge_type [net$`cycleway:left` %in% cycleway_types] <- "full" + } + if ("cycleway:right" %in% names (net)) { + net$edge_type [net$`cycleway:right` %in% cycleway_types] <- "full" + } bicycle_types <- c ( "designated", "sidepath", @@ -48,7 +54,9 @@ add_bike_infrastructure <- function (s, city, dlimit = 5000) { "share_busway", "sidewalk" ) - net$edge_type [net$cycleway %in% cycleway_types] <- "half" + if ("cycleway" %in% names (net)) { + net$edge_type [net$cycleway %in% cycleway_types] <- "half" + } # ----- weighting = 0.25 highway_types <- c ( @@ -64,14 +72,34 @@ add_bike_infrastructure <- function (s, city, dlimit = 5000) { ) net$edge_type [net$bicycle %in% bicycle_types] <- "quarter" + from <- s$osm_id + index <- which (!from %in% net$.vx0) + if (length (index) > 0L) { + # Not a bicycle network, so match points to nearest bike points: + v <- m4ra::m4ra_vertices (net, city) + from_xy <- sf::st_coordinates (s) + s_xy <- sf::st_coordinates (s) [index, ] + vert_index <- dodgr::match_pts_to_verts (v, s_xy) + from [index] <- v$id [vert_index] + } + d <- dodgr::dodgr_dists_categorical ( net, - from = s$osm_id, + from = from, proportions_only = TRUE, dlimit = dlimit ) - s$bike_index <- (d$full + 0.5 * d$half + 0.25 * d$quarter) / d$distance + nms <- c ("full", "half", "quarter") + wts <- c (1, 0.5, 0.25) + index <- which (nms %in% names (d)) + nms <- nms [index] + wts <- wts [index] + sums <- rep (0, nrow (s)) + for (n in seq_along (nms)) { + sums <- sums + d [[n]] * wts [n] + } + s$bike_index <- sums / d$distance return (s) } diff --git a/codemeta.json b/codemeta.json index 78113ce..4a0a2a4 100644 --- a/codemeta.json +++ b/codemeta.json @@ -7,7 +7,7 @@ "codeRepository": "https://github.com/UrbanAnalyst/uta-engine", "issueTracker": "https://github.com/UrbanAnalyst/uta-engine/issues", "license": "https://spdx.org/licenses/GPL-3.0", - "version": "0.1.0.122", + "version": "0.1.0.123", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R",