From e264ca8900c6286110caad4dbce476ec04805239 Mon Sep 17 00:00:00 2001 From: robinlovelace Date: Fri, 26 Apr 2024 04:57:37 +0100 Subject: [PATCH] Re-add n_segments, close #558 --- R/linefuns.R | 38 ++++++++++++++++++++++++++------------ man/line_segment.Rd | 19 +++++++++++++++---- man/line_segment1.Rd | 2 +- 3 files changed, 42 insertions(+), 17 deletions(-) diff --git a/R/linefuns.R b/R/linefuns.R index dda12fe1..67fd5531 100644 --- a/R/linefuns.R +++ b/R/linefuns.R @@ -159,6 +159,8 @@ line_midpoint <- function(l, tolerance = NULL) { #' #' @inheritParams line2df #' @param segment_length The approximate length of segments in the output (overrides n_segments if set) +#' @param n_segments The number of segments to divide the line into. +#' If there are multiple lines, this should be a vector of the same length. #' @param use_rsgeo Should the `rsgeo` package be used? #' If `rsgeo` is available, this faster implementation is used by default. #' If `rsgeo` is not available, the `lwgeom` package is used. @@ -183,40 +185,51 @@ line_midpoint <- function(l, tolerance = NULL) { line_segment <- function( l, segment_length = NA, + n_segments = NA, use_rsgeo = NULL, debug_mode = FALSE) { + # Defensive programming: + if (is.na(segment_length) && is.na(n_segments)) { + rlang::abort( + "segment_length or n_segments must be set.", + call = rlang::caller_env() + ) + } UseMethod("line_segment") } #' @export line_segment.sf <- function( l, segment_length = NA, + n_segments = NA, use_rsgeo = NULL, - debug_mode = FALSE) { - if (is.na(segment_length)) { - rlang::abort( - "`segment_length` must be set.", - call = rlang::caller_env() - ) - } + debug_mode = FALSE + ) { # Decide whether to use rsgeo or lwgeom, if not set: if (is.null(use_rsgeo)) { use_rsgeo <- use_rsgeo(l) } if (use_rsgeo) { # If using rsgeo, we can do the whole thing in one go: - segment_lengths <- as.numeric(sf::st_length(l)) - n_segments <- n_segments(segment_lengths, segment_length) + if (is.na(n_segments)) { + segment_lengths <- as.numeric(sf::st_length(l)) + n_segments <- n_segments(segment_lengths, segment_length) + } res <- line_segment_rsgeo(l, n_segments = n_segments) return(res) } + # lwgeom implementation: n_row_l <- nrow(l) if (n_row_l > 1) { res_list <- pbapply::pblapply(seq(n_row_l), function(i) { if (debug_mode) { message(paste0("Processing row ", i, " of ", n_row_l)) } - l_segmented <- line_segment1(l[i, ], n_segments = NA, segment_length = segment_length) + if (is.na(n_segments)) { + l_segmented <- line_segment1(l[i, ], n_segments = NA, segment_length = segment_length) + } else { + l_segmented <- line_segment1(l[i, ], n_segments = n_segments[i], segment_length = NA) + } res_names <- names(sf::st_drop_geometry(l_segmented)) # Work-around for https://github.com/ropensci/stplanr/issues/531 if (i == 1) { @@ -233,11 +246,11 @@ line_segment.sf <- function( res } - #' @export line_segment.sfc_LINESTRING <- function( l, segment_length = NA, + n_segments = NA, use_rsgeo = NULL, debug_mode = FALSE) { l <- sf::st_as_sf(l) @@ -267,7 +280,8 @@ line_segment.sfc_LINESTRING <- function( line_segment1 <- function( l, n_segments = NA, - segment_length = NA) { + segment_length = NA + ) { UseMethod("line_segment1") } #' @export diff --git a/man/line_segment.Rd b/man/line_segment.Rd index 830d0765..de45e96c 100644 --- a/man/line_segment.Rd +++ b/man/line_segment.Rd @@ -4,12 +4,21 @@ \alias{line_segment} \title{Divide an sf object with LINESTRING geometry into regular segments} \usage{ -line_segment(l, segment_length = NA, use_rsgeo = NULL, debug_mode = FALSE) +line_segment( + l, + segment_length = NA, + n_segments = NA, + use_rsgeo = NULL, + debug_mode = FALSE +) } \arguments{ \item{l}{A spatial lines object} -\item{segment_length}{The approximate length of segments in the output (overides n_segments if set)} +\item{segment_length}{The approximate length of segments in the output (overrides n_segments if set)} + +\item{n_segments}{The number of segments to divide the line into. +If there are multiple lines, this should be a vector of the same length.} \item{use_rsgeo}{Should the \code{rsgeo} package be used? If \code{rsgeo} is available, this faster implementation is used by default. @@ -30,11 +39,13 @@ l <- routes_fast_sf[2:4, ] l_seg_multi <- line_segment(l, segment_length = 1000, use_rsgeo = FALSE) # Number of subsegments table(l_seg_multi$ID) -plot(l_seg_multi, col = seq_along(l_seg_multi), lwd = 5) +plot(l_seg_multi["ID"]) +plot(l_seg_multi$geometry, col = seq_along(l_seg_multi), lwd = 5) round(st_length(l_seg_multi)) # rsgeo implementation: rsmulti = line_segment(l, segment_length = 1000, use_rsgeo = TRUE) -# plot(rsmulti, col = seq_along(l_seg_multi), lwd = 5) +plot(rsmulti["ID"]) +plot(rsmulti$geometry, col = seq_along(l_seg_multi), lwd = 5) # round(st_length(rsmulti)) # waldo::compare(l_seg_multi, rsmulti) } diff --git a/man/line_segment1.Rd b/man/line_segment1.Rd index 4974c337..02af3bf9 100644 --- a/man/line_segment1.Rd +++ b/man/line_segment1.Rd @@ -11,7 +11,7 @@ line_segment1(l, n_segments = NA, segment_length = NA) \item{n_segments}{The number of segments to divide the line into} -\item{segment_length}{The approximate length of segments in the output (overides n_segments if set)} +\item{segment_length}{The approximate length of segments in the output (overrides n_segments if set)} } \description{ Segment a single line, using lwgeom or rsgeo