Proportional dists

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: dodgr
 Title: Distances on Directed Graphs
-Version: 0.2.9.028
+Version: 0.2.9.029
 Authors@R: 
     c(person(given = "Mark",
              family = "Padgham",
@@ -71,5 +71,5 @@ Encoding: UTF-8
 LazyData: true
 NeedsCompilation: yes
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 SystemRequirements: C++11, GNU make

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(summary,dodgr_dists_proportional)
 S3method(weight_streetnet,default)
 S3method(weight_streetnet,sc)
 S3method(weight_streetnet,sf)
@@ -13,6 +14,7 @@ export(dodgr_components)
 export(dodgr_contract_graph)
 export(dodgr_distances)
 export(dodgr_dists)
+export(dodgr_dists_proportional)
 export(dodgr_flowmap)
 export(dodgr_flows_aggregate)
 export(dodgr_flows_disperse)

R/RcppExports.R

@@ -299,6 +299,19 @@ rcpp_get_paths <- function(graph, vert_map_in, fromi, toi_in, heap_type) {
     .Call(`_dodgr_rcpp_get_paths`, graph, vert_map_in, fromi, toi_in, heap_type)
 }
 
+#' rcpp_get_sp_dists_proportional
+#'
+#' The `graph` must have an `edge_type` column of non-negative integers,
+#' with 0 denoting edges which are not aggregated, and all other values
+#' defining aggregation categories.
+#'
+#' Implemented in parallal form only; no single-threaded version, and
+#' only for AStar (so graphs must be spatial).
+#' @noRd
+rcpp_get_sp_dists_proportional <- function(graph, vert_map_in, fromi, toi_in, heap_type) {
+    .Call(`_dodgr_rcpp_get_sp_dists_proportional`, graph, vert_map_in, fromi, toi_in, heap_type)
+}
+
 #' rcpp_gen_hash
 #'
 #' Efficient generation of long sequences of hash keys

R/dists-proportional.R

@@ -0,0 +1,107 @@
+#' Proportional distances along different edge categories
+#'
+#' @inheritParams dodgr_dists
+#' @param graph `data.frame` or equivalent object representing the network
+#' graph which must have a column named "edge_type" which labels categories of
+#' edge types along which proportional distances are to be aggregated (see
+#' Note).
+#' @return A list of distance matrices of equal dimensions (length(from),
+#' length(to)), the first of which ("distance") holds the final distances, while
+#' the rest are one matrix for each unique value of "edge_type", holding the
+#' distances traversed along those types of edges only.
+#'
+#' @note The "edge_type" column in the graph can contain any kind of discrete or
+#' categorical values, although integer values of 0 are not permissible. `NA`
+#' values are ignored.
+#' @export
+dodgr_dists_proportional <- function (graph,
+                                      from = NULL,
+                                      to = NULL,
+                                      heap = "BHeap",
+                                      quiet = TRUE) {
+
+    if (!"edge_type" %in% names (graph))
+        stop ("graph must have a column named 'edge_type'")
+    if (is.integer (graph$edge_type) & any (graph$edge_type == 0L))
+        stop ("graphs with integer edge_type columns may not contain 0s")
+
+    edge_type <- graph$edge_type
+    graph <- tbl_to_df (graph)
+
+    hps <- get_heap (heap, graph)
+    heap <- hps$heap
+    graph <- hps$graph
+
+    gr_cols <- dodgr_graph_cols (graph)
+    if (is.na (gr_cols$from) | is.na (gr_cols$to)) {
+        scols <- find_spatial_cols (graph)
+        graph$from_id <- scols$xy_id$xy_fr_id
+        graph$to_id <- scols$xy_id$xy_to_id
+        gr_cols <- dodgr_graph_cols (graph)
+    }
+    is_spatial <- is_graph_spatial (graph)
+    if (!is_spatial)
+        stop ("proportional distances only implemented for spatial graphs")
+
+    vert_map <- make_vert_map (graph, gr_cols, is_spatial)
+
+    # adjust to/from for turn penalty where that exists:
+    from <- to_from_with_tp (graph, from, from = TRUE)
+    to <- to_from_with_tp (graph, to, from = FALSE)
+
+    from_index <- get_to_from_index (graph, vert_map, gr_cols, from)
+    to_index <- get_to_from_index (graph, vert_map, gr_cols, to)
+
+    graph <- convert_graph (graph, gr_cols)
+    edge_type_table <- table (edge_type)
+    graph$edge_type <- match (edge_type, names (edge_type_table))
+    graph$edge_type [is.na (graph$edge_type)] <- 0L
+
+    if (!quiet)
+        message ("Calculating shortest paths ... ", appendLF = FALSE)
+
+    d <- rcpp_get_sp_dists_proportional (graph,
+                                         vert_map,
+                                         from_index$index,
+                                         to_index$index,
+                                         heap)
+
+    n <-length (to)
+    d0 <- list ("distances" = d [, seq (n)])
+    d <- lapply (seq_along (edge_type_table), function (i) {
+                     index <- i * n + seq (n) - 1
+                     d [, index]    })
+    names (d) <- names (edge_type_table)
+
+    res <- c (d0, d)
+    class (res) <- append (class (res), "dodgr_dists_proportional")
+
+    return (res)
+}
+
+
+#' Transform a result from 'dodgr_dists_proportional' to summary statistics
+#'
+#' @param object A 'dodgr_dists_proportional' object
+#' @param ... Extra parameters currently not used
+#' @return The summary statistics (invisibly)
+#' @export
+summary.dodgr_dists_proportional <- function (object, ...) {
+
+    edge_types <- names (object) [-1]
+
+    d0 <- object$distances # first list item
+    sum_d0 <- sum (d0, na.rm = TRUE)
+    object <- object [-1]
+
+    dprop <- vapply (object, function (i)
+                     sum (i, na.rm = TRUE) / sum_d0,
+                     numeric (1))
+
+    message ("Proportional distances along each kind of edge:")
+    for (i in seq_along (dprop))
+        message ("  ", names (dprop) [i],
+                 ": ", round (dprop [i], digits = 4))
+
+    invisible (dprop)
+}

codemeta.json

@@ -10,7 +10,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.9.028",
+  "version": "0.2.9.029",
   "programmingLanguage": {
     "@type": "ComputerLanguage",
     "name": "R",

src/Makevars

@@ -8,7 +8,7 @@ OBJ_HEAPS = heaps/bheap.o heaps/fheap.o heaps/heap23.o \
     heaps/triheap_ext.o heaps/triheap.o
 OBJ_SRC = centrality.o dgraph.o pathfinders.o dodgr-to-sf.o flows.o fund-cycles.o \
     graph-contract.o graph.o graph-sample.o RcppExports.o run_sp.o \
-    sc-as-network.o sf-as-network.o turn_penalty.o
+    run_sp_proportional.o sc-as-network.o sf-as-network.o turn_penalty.o
 OBJECTS = $(OBJ_HEAPS) $(OBJ_SRC)
 
 .PHONY: all clean

src/Makevars.win

@@ -9,7 +9,7 @@ OBJ_HEAPS = heaps/bheap.o heaps/fheap.o heaps/heap23.o \
     heaps/triheap_ext.o heaps/triheap.o
 OBJ_SRC = centrality.o dgraph.o pathfinders.o dodgr-to-sf.o flows.o fund-cycles.o \
     graph-contract.o graph.o graph-sample.o RcppExports.o run_sp.o \
-    sc-as-network.o sf-as-network.o turn_penalty.o
+    run_sp_proportional.o sc-as-network.o sf-as-network.o turn_penalty.o
 OBJECTS = $(OBJ_HEAPS) $(OBJ_SRC)
 
 .PHONY: all clean

src/RcppExports.cpp

@@ -242,6 +242,21 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// rcpp_get_sp_dists_proportional
+Rcpp::NumericMatrix rcpp_get_sp_dists_proportional(const Rcpp::DataFrame graph, const Rcpp::DataFrame vert_map_in, Rcpp::IntegerVector fromi, Rcpp::IntegerVector toi_in, const std::string& heap_type);
+RcppExport SEXP _dodgr_rcpp_get_sp_dists_proportional(SEXP graphSEXP, SEXP vert_map_inSEXP, SEXP fromiSEXP, SEXP toi_inSEXP, SEXP heap_typeSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< const Rcpp::DataFrame >::type graph(graphSEXP);
+    Rcpp::traits::input_parameter< const Rcpp::DataFrame >::type vert_map_in(vert_map_inSEXP);
+    Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type fromi(fromiSEXP);
+    Rcpp::traits::input_parameter< Rcpp::IntegerVector >::type toi_in(toi_inSEXP);
+    Rcpp::traits::input_parameter< const std::string& >::type heap_type(heap_typeSEXP);
+    rcpp_result_gen = Rcpp::wrap(rcpp_get_sp_dists_proportional(graph, vert_map_in, fromi, toi_in, heap_type));
+    return rcpp_result_gen;
+END_RCPP
+}
 // rcpp_gen_hash
 Rcpp::CharacterVector rcpp_gen_hash(const int n, const size_t hash_len);
 RcppExport SEXP _dodgr_rcpp_gen_hash(SEXP nSEXP, SEXP hash_lenSEXP) {
@@ -309,6 +324,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_dodgr_rcpp_get_iso", (DL_FUNC) &_dodgr_rcpp_get_iso, 5},
     {"_dodgr_rcpp_get_sp_dists", (DL_FUNC) &_dodgr_rcpp_get_sp_dists, 5},
     {"_dodgr_rcpp_get_paths", (DL_FUNC) &_dodgr_rcpp_get_paths, 5},
+    {"_dodgr_rcpp_get_sp_dists_proportional", (DL_FUNC) &_dodgr_rcpp_get_sp_dists_proportional, 5},
     {"_dodgr_rcpp_gen_hash", (DL_FUNC) &_dodgr_rcpp_gen_hash, 2},
     {"_dodgr_rcpp_sf_as_network", (DL_FUNC) &_dodgr_rcpp_sf_as_network, 2},
     {"_dodgr_rcpp_points_index_par", (DL_FUNC) &_dodgr_rcpp_points_index_par, 2},

src/pathfinders.h

@@ -86,6 +86,15 @@ class PathFinder {
                 const bool *m_closed_vec,
                 const size_t &v0,
                 const std::vector<double> &heur);
+        void scan_edge_types_heur ( // with A* heuristic
+                const DGraphEdge *edge,
+                std::vector<double>& d,
+                std::vector<double>& w,
+                std::vector<long int>& prev,
+                bool *m_open_vec,
+                const bool *m_closed_vec,
+                const size_t &v0,
+                const std::vector<double> &heur);
 
         void Dijkstra (
                 std::vector<double>& d,
@@ -105,6 +114,12 @@ class PathFinder {
                 const std::vector<double>& heur,
                 const size_t v0,
                 const std::vector <size_t> &to_index);
+        void AStarEdgeType (std::vector<double>& d,
+                std::vector<double>& w,
+                std::vector<long int>& prev,
+                const std::vector<double>& heur,
+                const size_t v0,
+                const std::vector <size_t> &to_index);
         void Dijkstra_set (std::vector <double>& d,
                 std::vector<double>& w,
                 std::vector<long int>& prev,

src/run_sp.h

@@ -38,6 +38,12 @@ void make_vert_to_edge_maps (const std::vector <std::string> &from,
 size_t get_chunk_size (const size_t nfrom);
 } // end namespace run_sp
 
+namespace proportional {
+
+size_t num_edge_types (const std::vector <size_t> &edge_type);
+
+} // end namespace proportional
+
 
 Rcpp::NumericMatrix rcpp_get_sp_dists (const Rcpp::DataFrame graph,
         const Rcpp::DataFrame vert_map_in,