diff --git a/R/get_oaproc.R b/R/get_oaproc.R index af8bd306..a26debeb 100644 --- a/R/get_oaproc.R +++ b/R/get_oaproc.R @@ -61,6 +61,10 @@ get_raindrop_trace <- function(point, direction = "down") { #' most users of this function will want to use \link{get_raindrop_trace} prior #' to calls to this function. #' +#' An attempt is made to eliminate polygon shards if they exist in the output. +#' However, there is a chance that this function will return a multipolygon +#' data.frame. +#' #' @export #' @examples #' \donttest{ @@ -115,10 +119,40 @@ get_split_catchment <- function(point, upstream = TRUE) { url <- paste0(url_base, "nldi-splitcatchment/execution") - return(sf_post(url, make_json_input_split(point, upstream), + out <- sf_post(url, make_json_input_split(point, upstream), err_mess = paste("Ensure that the point you submitted is within\n the", - "coterminous US and consider trying get_raindrop_trace\ to ensure", - "your point is not too close to a catchment boundary."))) + "coterminous US and consider trying get_raindrop_trace\ to ensure", + "your point is not too close to a catchment boundary.")) + + try({ + if(!is.null(out)) { + sf::st_geometry(out) <- sf::st_sfc(lapply(sf::st_geometry(out), remove_shards), + crs = sf::st_crs(out)) + + if(sf::st_geometry_type(out, by_geometry = FALSE) == "GEOMETRY") { + sf::st_geometry(out) <- sf::st_sfc(lapply(sf::st_geometry(out), + sf::st_cast, to = "MULTIPOLYGON"), + crs = sf::st_crs(out)) + } + } + }, silent = TRUE) + + return(out) +} + +remove_shards <- function(g, thresh = 0.01) { + + if(length(g) == 1) return(sf::st_polygon(g[[1]])) + + p <- sf::st_cast(sf::st_sfc(g), "POLYGON") + + a <- sf::st_area(p) + + p <- p[a > max(a) * thresh] + + if(length(p) > 1) return(sf::st_multipolygon(p)) + + sf::st_polygon(p[[1]]) } #' Get Cross Section From Point (experimental) diff --git a/man/get_split_catchment.Rd b/man/get_split_catchment.Rd index c1552d80..7515be0b 100644 --- a/man/get_split_catchment.Rd +++ b/man/get_split_catchment.Rd @@ -28,6 +28,10 @@ the catchment will be split across the flow line. IF the point is not along the flowline a small sub catchment will typically result. As a result, most users of this function will want to use \link{get_raindrop_trace} prior to calls to this function. + +An attempt is made to eliminate polygon shards if they exist in the output. +However, there is a chance that this function will return a multipolygon +data.frame. } \examples{ \donttest{