From 323c01a13a2f3b41250e886d692f8d77f5a03ad6 Mon Sep 17 00:00:00 2001 From: anguswg-ucsb Date: Mon, 2 Dec 2024 07:10:51 -0800 Subject: [PATCH] fixed error that was happening when POINT geometries were produced from st_intersection in trim_transects_to_polygons() function --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/transect_to_polygon_extender.R | 7 ++++++- tests/testthat/test-trim-transects-to-polygons.R | 11 +++++++---- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b428d9c..0153b5f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: hydrofabric3D Title: hydrofabric3D -Version: 0.1.85 +Version: 0.1.86 Authors@R: c(person("Mike", "Johnson", role = c("aut"), email = "mikecp11@gmail.com"), person("Angus", "Watters", role = c("aut", "cre"), email = "anguswatters@gmail.com"), person("Arash", "Modaresi", role = "ctb"), diff --git a/NAMESPACE b/NAMESPACE index dd926cd..abb0da9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -154,6 +154,7 @@ importFrom(sf,st_difference) importFrom(sf,st_distance) importFrom(sf,st_drop_geometry) importFrom(sf,st_geometry) +importFrom(sf,st_geometry_type) importFrom(sf,st_intersection) importFrom(sf,st_intersects) importFrom(sf,st_is_empty) diff --git a/R/transect_to_polygon_extender.R b/R/transect_to_polygon_extender.R index 83261bb..23faada 100644 --- a/R/transect_to_polygon_extender.R +++ b/R/transect_to_polygon_extender.R @@ -1253,7 +1253,7 @@ get_line_node_pts <- function( #' @param dissolve logical, whether to dissolve polygon internal boundaries or not. Default is FALSE. #' @importFrom dplyr filter select any_of mutate bind_rows n slice_max group_by ungroup across distinct #' @importFrom rmapshaper ms_explode -#' @importFrom sf st_intersection +#' @importFrom sf st_intersection st_geometry_type #' @importFrom hydroloom rename_geometry #' @return sf dataframe #' @export @@ -1353,6 +1353,7 @@ trim_transects_to_polygons <- function(transect_lines, dplyr::select(-dplyr::any_of(POLYGON_ID)) %>% sf::st_intersection(polygons) %>% dplyr::select(!dplyr::any_of(c(POLYGON_ID, paste0(POLYGON_ID, ".1")))) %>% + dplyr::filter(sf::st_geometry_type(geometry) %in% c("LINESTRING", "MULTILINESTRING")) %>% rmapshaper::ms_explode() %>% add_intersects_ids( flowlines %>% @@ -1415,6 +1416,10 @@ trim_transects_to_polygons <- function(transect_lines, merged_transects %>% cs_arrange(crosswalk_id = crosswalk_id, order_by = "cs_id") + # recalculate lengths + merged_transects <- + merged_transects %>% + add_length_col("cs_lengthm") return(merged_transects) } diff --git a/tests/testthat/test-trim-transects-to-polygons.R b/tests/testthat/test-trim-transects-to-polygons.R index 773ac1a..408d59b 100644 --- a/tests/testthat/test-trim-transects-to-polygons.R +++ b/tests/testthat/test-trim-transects-to-polygons.R @@ -538,7 +538,8 @@ testthat::test_that("trim_transects_to_polygons() a single set of transects with ) %>% dplyr::mutate( is_extended = left_distance > 0 | right_distance > 0 - ) + ) %>% + hydrofabric3D::add_length_col("old_length") # %>% # dplyr::select( # dplyr::any_of(CROSSWALK_ID), @@ -627,7 +628,7 @@ testthat::test_that("trim_transects_to_polygons() a single set of transects with was_not_trimmed$new_length ) - actually_trimmed_transects_are_not_equal_length <- was_trimmed$cs_lengthm != was_trimmed$new_length + actually_trimmed_transects_are_not_equal_length <- was_trimmed$old_length != was_trimmed$new_length testthat::expect_true( actually_trimmed_transects_are_not_equal_length ) @@ -703,7 +704,8 @@ testthat::test_that("trim_transects_to_polygons() a single set of transects with keep_lengths = FALSE, reindex_cs_ids = FALSE, verbose = TRUE - ) + ) %>% + hydrofabric3D::add_length_col("old_length") # plot(flowlines$geom, col = "blue", add = F) # plot(big_polygons$geom, col = scales::alpha("pink", 0.3), add = T) @@ -783,13 +785,14 @@ testthat::test_that("trim_transects_to_polygons() a single set of transects with dplyr::filter(id == "wb-1003265", cs_id %in% c(9, 10)) %>% hydrofabric3D::add_length_col("new_length") - actually_trimmed_transects_are_not_equal_length <- all(was_trimmed$cs_lengthm != was_trimmed$new_length) + actually_trimmed_transects_are_not_equal_length <- all(was_trimmed$old_length != was_trimmed$new_length) testthat::expect_true( actually_trimmed_transects_are_not_equal_length ) }) + testthat::test_that("trim_transects_to_polygons() complex junction flowlines with all flowlines having a polygon to trim against", { flowlines <- sf::read_sf(testthat::test_path("testdata", "junction_flowlines.gpkg"))