diff --git a/NEWS.md b/NEWS.md index 12b4a969..04a31660 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ - `line_segment()` becomes an S3 generic which now has methods for `sf` and `sfc` class objects - `line_segment()` now works around [{rsgeo} issue](https://github.com/JosiahParry/rsgeo/issues/42) with `line_segmentize()` returning fewer segments than requested (#552) - Removal of offending URLs with `urlchecker::check_urls()` +- Improvement of documentation of `line_midpoint()`: comparison of output with `sf::st_point_on_surface()` # stplanr 1.1.2 (2023-09) diff --git a/R/linefuns.R b/R/linefuns.R index 0d54554f..57fa30d9 100644 --- a/R/linefuns.R +++ b/R/linefuns.R @@ -140,6 +140,9 @@ angle_diff <- function(l, angle, bidirectional = FALSE, absolute = TRUE) { #' plot(l$geometry, col = 2:5) #' midpoints <- line_midpoint(l) #' plot(midpoints, add = TRUE) +#' # compare with sf::st_point_on_surface: +#' midpoints2 <- sf::st_point_on_surface(l) +#' plot(midpoints2, add = TRUE, col = "red") line_midpoint <- function(l, tolerance = NULL) { if (is.null(tolerance)) { sub <- lwgeom::st_linesubstring(x = l, from = 0, to = 0.5) @@ -158,7 +161,9 @@ line_midpoint <- function(l, tolerance = NULL) { #' but does not always return the number of segments requested. #' #' @inheritParams line2df -#' @param segment_length The approximate length of segments in the output (overides n_segments if set) +#' @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. @@ -174,30 +179,54 @@ line_midpoint <- function(l, tolerance = NULL) { #' 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["ID"]) -#' plot(rsmulti$geometry, col = seq_along(l_seg_multi), lwd = 5) -#' # round(st_length(rsmulti)) -#' # waldo::compare(l_seg_multi, rsmulti) +#' # rsgeo implementation (default if available): +#' if (rlang::is_installed("rsgeo")) { +#' rsmulti = line_segment(l, segment_length = 1000, use_rsgeo = TRUE) +#' plot(rsmulti["ID"]) +#' } +#' # Check they have the same total length, to nearest mm: +#' # round(sum(st_length(l_seg_multi)), 3) == round(sum(st_length(rsmulti)), 3) +#' # With n_segments for 1 line: +#' l_seg_multi_n <- line_segment(l[1, ], n_segments = 3, use_rsgeo = FALSE) +#' l_seg_multi_n <- line_segment(l$geometry[1], n_segments = 3, use_rsgeo = FALSE) +#' l_seg_multi_n <- line_segment(l$geometry[1], n_segments = 3, use_rsgeo = TRUE) +#' # With n_segments for all 3 lines: +#' l_seg_multi_n <- line_segment(l, n_segments = 2) +#' nrow(l_seg_multi_n) == nrow(l) * 2 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 + ) { + # Get n_segments if not provided: + if (is.na(n_segments)) { + segment_lengths <- as.numeric(sf::st_length(l)) + n_segments <- n_segments(segment_lengths, segment_length) + } else { + if (length(n_segments) != nrow(l)) { + if (length(n_segments) == 1) { + message("Setting n_segments to ", n_segments, " for all lines") + n_segments <- rep.int(n_segments, nrow(l)) + } + } } # Decide whether to use rsgeo or lwgeom, if not set: if (is.null(use_rsgeo)) { @@ -205,18 +234,17 @@ line_segment.sf <- function( } 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) 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) + 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) { @@ -228,20 +256,20 @@ line_segment.sf <- function( res <- bind_sf(res_list) } else { # If there's only one row: - res <- line_segment1(l, n_segments = NA, segment_length = segment_length) + res <- line_segment1(l, n_segments = n_segments) } 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) - res <- line_segment(l, segment_length = segment_length, use_rsgeo, debug_mode) + res <- line_segment(l, segment_length = segment_length, n_segments = n_segments, use_rsgeo, debug_mode) sf::st_geometry(res) } @@ -267,7 +295,8 @@ line_segment.sfc_LINESTRING <- function( line_segment1 <- function( l, n_segments = NA, - segment_length = NA) { + segment_length = NA + ) { UseMethod("line_segment1") } #' @export @@ -383,7 +412,7 @@ line_segment_rsgeo <- function(l, n_segments) { res_sf <- sf::st_as_sf( res_tbl, geometry = res, - crs = crs + crs = crs ) res_sf } diff --git a/cran-comments.md b/cran-comments.md index 8cec43e7..7d04aed3 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,4 +1,4 @@ -Bug fix release, with offending URLs removed thanks to feedback from CRAN. +Fix to reverse dependencies ## R CMD check results diff --git a/man/line_midpoint.Rd b/man/line_midpoint.Rd index fe295ae6..b9ce490b 100644 --- a/man/line_midpoint.Rd +++ b/man/line_midpoint.Rd @@ -20,6 +20,9 @@ l <- routes_fast_sf[2:5, ] plot(l$geometry, col = 2:5) midpoints <- line_midpoint(l) plot(midpoints, add = TRUE) +# compare with sf::st_point_on_surface: +midpoints2 <- sf::st_point_on_surface(l) +plot(midpoints2, add = TRUE, col = "red") } \seealso{ Other lines: diff --git a/man/line_segment.Rd b/man/line_segment.Rd index 830d0765..04e3da14 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,13 +39,23 @@ 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) -# round(st_length(rsmulti)) -# waldo::compare(l_seg_multi, rsmulti) +# rsgeo implementation (default if available): +if (rlang::is_installed("rsgeo")) { + rsmulti = line_segment(l, segment_length = 1000, use_rsgeo = TRUE) + plot(rsmulti["ID"]) +} +# Check they have the same total length, to nearest mm: +# round(sum(st_length(l_seg_multi)), 3) == round(sum(st_length(rsmulti)), 3) +# With n_segments for 1 line: +l_seg_multi_n <- line_segment(l[1, ], n_segments = 3, use_rsgeo = FALSE) +l_seg_multi_n <- line_segment(l$geometry[1], n_segments = 3, use_rsgeo = FALSE) +l_seg_multi_n <- line_segment(l$geometry[1], n_segments = 3, use_rsgeo = TRUE) +# With n_segments for all 3 lines: +l_seg_multi_n <- line_segment(l, n_segments = 2) +nrow(l_seg_multi_n) == nrow(l) * 2 } \seealso{ Other lines: 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 diff --git a/revdep/README.md b/revdep/README.md new file mode 100644 index 00000000..81c4e719 --- /dev/null +++ b/revdep/README.md @@ -0,0 +1,46 @@ +# Platform + +|field |value | +|:--------|:------------------------------------------------------------------------------------| +|version |R version 4.3.3 (2024-02-29) | +|os |Ubuntu 22.04.4 LTS | +|system |x86_64, linux-gnu | +|ui |RStudio | +|language |en_GB:en | +|collate |en_GB.UTF-8 | +|ctype |en_GB.UTF-8 | +|tz |Europe/London | +|date |2024-04-26 | +|rstudio |2024.04.0-daily+662 Chocolate Cosmos (desktop) | +|pandoc |3.1.11 @ /usr/lib/rstudio/resources/app/bin/quarto/bin/tools/x86_64/ (via rmarkdown) | + +# Dependencies + +|package |old |new |Δ | +|:----------|:-----|:---------|:--| +|stplanr |1.1.2 |1.2.0 |* | +|curl |NA |5.2.1 |* | +|data.table |NA |1.15.4 |* | +|DBI |NA |1.2.2 |* | +|geosphere |NA |1.5-18 |* | +|lwgeom |NA |0.2-14 |* | +|nabor |0.5.0 |0.5.0 | | +|od |0.4.4 |0.4.4 | | +|openssl |NA |2.1.2 |* | +|pbapply |1.7-2 |1.7-2 | | +|RcppEigen |NA |0.3.4.0.0 |* | +|sf |NA |1.0-16 |* | +|sp |NA |2.1-3 |* | +|tidyselect |NA |1.2.1 |* | +|units |NA |0.8-5 |* | + +# Revdeps + +## Failed to check (3) + +|package |version |error |warning |note | +|:--------------|:-------|:-----|:-------|:----| +|agricolaeplotr |? | | | | +|cyclestreets |? | | | | +|pct |? | | | | + diff --git a/revdep/cran.md b/revdep/cran.md new file mode 100644 index 00000000..cb582d73 --- /dev/null +++ b/revdep/cran.md @@ -0,0 +1,7 @@ +## revdepcheck results + +We checked 3 reverse dependencies (0 from CRAN + 3 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. + + * We saw 0 new problems + * We failed to check 0 packages + diff --git a/revdep/data.sqlite b/revdep/data.sqlite new file mode 100644 index 00000000..a1d6309e Binary files /dev/null and b/revdep/data.sqlite differ diff --git a/revdep/failures.md b/revdep/failures.md new file mode 100644 index 00000000..d79aa5d5 --- /dev/null +++ b/revdep/failures.md @@ -0,0 +1,99 @@ +# agricolaeplotr + +
+ +* Version: +* GitHub: https://github.com/ropensci/stplanr +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` +# cyclestreets + +
+ +* Version: +* GitHub: https://github.com/ropensci/stplanr +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` +# pct + +
+ +* Version: +* GitHub: https://github.com/ropensci/stplanr +* Source code: NA +* Number of recursive dependencies: 0 + +
+ +## Error before installation + +### Devel + +``` + + + + + + +``` +### CRAN + +``` + + + + + + +``` diff --git a/revdep/problems.md b/revdep/problems.md new file mode 100644 index 00000000..9a207363 --- /dev/null +++ b/revdep/problems.md @@ -0,0 +1 @@ +*Wow, no problems at all. :)* \ No newline at end of file