|
27 | 27 | .check_set_caller(".sf_get_samples")
|
28 | 28 | # Pre-condition - is the sf object has geometries?
|
29 | 29 | .check_that(nrow(sf_object) > 0)
|
30 |
| - # Precondition - can the function deal with the geometry_type? |
| 30 | + # Pre-condition - can the function deal with the geometry_type? |
31 | 31 | geom_type <- as.character(sf::st_geometry_type(sf_object)[[1]])
|
32 | 32 | sf_geom_types_supported <- .conf("sf_geom_types_supported")
|
33 | 33 | .check_that(geom_type %in% sf_geom_types_supported)
|
34 |
| - |
35 | 34 | # Get the points to be read
|
36 | 35 | samples <- .sf_to_tibble(
|
37 | 36 | sf_object = sf_object,
|
|
76 | 75 | sampling_type,
|
77 | 76 | start_date,
|
78 | 77 | end_date) {
|
79 |
| - |
80 |
| - # Remove empty geometries if exists |
81 |
| - are_empty_geoms <- sf::st_is_empty(sf_object) |
82 |
| - if (any(are_empty_geoms)) { |
83 |
| - if (.check_warnings()) { |
84 |
| - warning(.conf("messages", ".sf_to_tibble"), |
85 |
| - immediate. = TRUE, call. = FALSE |
86 |
| - ) |
87 |
| - } |
88 |
| - sf_object <- sf_object[!are_empty_geoms, ] |
89 |
| - } |
| 78 | + # Remove invalid geometries (malformed and empty ones) |
| 79 | + sf_object <- .sf_clean(sf_object) |
90 | 80 | # If the sf object is not in planar coordinates, convert it
|
91 | 81 | sf_object <- suppressWarnings(
|
92 | 82 | sf::st_transform(sf_object, crs = "EPSG:4326")
|
93 | 83 | )
|
94 |
| - |
95 | 84 | # Get the geometry type
|
96 | 85 | geom_type <- as.character(sf::st_geometry_type(sf_object)[[1]])
|
97 | 86 | # Get a tibble with points and labels
|
|
239 | 228 | })
|
240 | 229 | return(points_tab)
|
241 | 230 | }
|
| 231 | + |
| 232 | +#' @title Clean invalid geometries |
| 233 | +#' @name .sf_clean |
| 234 | +#' @description Malformed and empty geometries are defined as invalid |
| 235 | +#' @keywords internal |
| 236 | +#' @noRd |
| 237 | +#' @param sf_object sf object to be validated |
| 238 | +#' @return sf object with no invalid geometries. |
| 239 | +#' |
| 240 | +.sf_clean <- function(sf_object) { |
| 241 | + # condition 1 - geometry is valid |
| 242 | + is_geometry_valid <- sf::st_is_valid(sf_object) |
| 243 | + # condition 2 - geometry is not empty |
| 244 | + is_geometry_valid <- is_geometry_valid & !sf::st_is_empty(sf_object) |
| 245 | + # warning user in case of invalid geometries |
| 246 | + if (!all(is_geometry_valid)) { |
| 247 | + warning(.conf("messages", ".sf_clean")) |
| 248 | + } |
| 249 | + # return only valid geometries |
| 250 | + sf_object[is_geometry_valid,] |
| 251 | +} |
0 commit comments