Skip to content

Commit

Permalink
Add test and browser() for #520
Browse files Browse the repository at this point in the history
  • Loading branch information
Robinlovelace committed Aug 24, 2023
1 parent 6583e63 commit 9bb59e5
Show file tree
Hide file tree
Showing 2 changed files with 31 additions and 6 deletions.
25 changes: 19 additions & 6 deletions R/rnet_join.R
Original file line number Diff line number Diff line change
Expand Up @@ -37,6 +37,10 @@
#' into linestrings with a max distance. Around 5 (m) may be a sensible
#' default for many use cases, the smaller the value the slower the process.
#' @param endCapStyle Type of buffer. See `?sf::st_buffer` for details
#' @param within Should the join be based on `sf::st_within` or `sf::st_intersects`?
#' `TRUE` by default. If `FALSE` the centroid of each segment of `rnet_y` is
#' used for the join. Note: this can result in incorrectly assigning values
#' on sideroads, as documented in [#520](https://github.com/ropensci/stplanr/issues/520).
#' @param ... Additional arguments passed to `rnet_subset`.
#' @examples
#' library(sf)
Expand All @@ -63,34 +67,43 @@
#' summarise(
#' flow = weighted.mean(flow, length_y, na.rm = TRUE),
#' )
#' osm_joined_rnet = left_join(osm_net_example, rnetj_summary)
#' osm_joined_rnet = dplyr::left_join(osm_net_example, rnetj_summary)
#' plot(sf::st_geometry(route_network_small))
#' plot(route_network_small["flow"], lwd = 3, add = TRUE)
#' plot(sf::st_geometry(osm_joined_rnet), add = TRUE)
#' plot(osm_joined_rnet[c("flow")], lwd = 9, add = TRUE)
#' # Improve fit between geometries and performance by subsetting rnet_x
#' osm_subset = rnet_subset(osm_net_example, route_network_small, dist = 5)
#' osm_joined_rnet = left_join(osm_subset, rnetj_summary)
#' osm_joined_rnet = dplyr::left_join(osm_subset, rnetj_summary)
#' plot(route_network_small["flow"])
#' plot(osm_joined_rnet[c("flow")])
#' # mapview(joined_network) +
#' # mapview(route_network_small)
#' @export
rnet_join = function(rnet_x, rnet_y, dist = 5, length_y = TRUE, key_column = 1,
subset_x = TRUE, dist_subset = 5, segment_length = 0,
endCapStyle = "FLAT", ...) {
subset_x = TRUE, dist_subset = NULL, segment_length = 0,
endCapStyle = "FLAT", within = TRUE, ...) {
if (subset_x) {
rnet_x = rnet_subset(rnet_x, rnet_y, dist = dist_subset, ...)
}
if (is.null(dist_subset)) {
dist_subset = dist + 1
}
rnet_x_buffer = geo_buffer(rnet_x, dist = dist, nQuadSegs = 2, endCapStyle = endCapStyle)
if (segment_length > 0) {
rnet_y = line_segment(rnet_y, segment_length = segment_length)
}
if (length_y) {
rnet_y$length_y = as.numeric(sf::st_length(rnet_y))
}
rnet_y_centroids = sf::st_centroid(rnet_y)
rnetj = sf::st_join(rnet_x_buffer[key_column], rnet_y_centroids)
browser()
if (within) {
rnetj = sf::st_join(rnet_x_buffer[key_column], rnet_y, join = sf::st_within)
} else {
rnet_y_centroids = sf::st_centroid(rnet_y)
rnetj = sf::st_join(rnet_x_buffer[key_column], rnet_y_centroids)
}

rnetj
}

Expand Down
12 changes: 12 additions & 0 deletions data-raw/ad-hoc-tests/test-sideroads.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,12 @@
remotes::install_dev("stplanr")
library(stplanr)

rnet_x = rnet_subset(osm_net_example[1], route_network_small)
# The source object:
rnet_y = route_network_small["flow"]
rnet_y$quietness = rnorm(nrow(rnet_y))
funs = list(flow = sum, quietness = mean)
rnet_merged = rnet_merge(rnet_x[1], rnet_y[c("flow", "quietness")],
dist = 9, segment_length = 20, funs = funs)
plot(rnet_y["flow"])
plot(rnet_merged["flow"])

0 comments on commit 9bb59e5

Please sign in to comment.