internal checks

R/add_coordinate_uncertainty.R

@@ -14,7 +14,7 @@
 #' @export
 #'
 #' @import sf
-#' @importFrom cli cli_abort
+#' @importFrom stats setNames
 #'
 #' @family main
 #'
@@ -49,52 +49,30 @@
 add_coordinate_uncertainty <- function(
     observations,
     coords_uncertainty_meters = 25) {
+  ### Start checks
+  # 1. Check input type and length
+  # Check if observations is an sf object
+  stopifnot("`observations` must be an sf object with POINT geometry." =
+              inherits(observations, "sf") &&
+              sf::st_geometry_type(observations,
+                                   by_geometry = FALSE) == "POINT")
 
-  ## checks
-  ## is it sf object
-  if (!inherits(observations, "sf")) {
-    cli::cli_abort(c(
-      "{.var observations}  must be an object of class 'sf'",
-      "x" = paste(
-        "You've supplied an object of class {.cls {class(observations)}}"
-      )
-    ))
-  }
-  ## check if coords_uncertainty_meters is numeric
-  if (!is.numeric(coords_uncertainty_meters)) {
-    cli::cli_abort(
-      "{.var coords_uncertainty_meters must be a numeric value}"
-    )
-  }
+  # Check if coords_uncertainty_meters is numeric
+  stopifnot("`coords_uncertainty_meters` must be  numeric vector." =
+              is.numeric(coords_uncertainty_meters))
 
-  ## is geometry type POINT?
-  is_point <- sf::st_geometry_type(observations, by_geometry = FALSE) == "POINT"
-  if (!is_point) {
-    cli::cli_abort(c(
-      "{.var observations} must be a 'sf' object with POINT geometry",
-      paste("x" = "You've supplied an 'sf' object of geometry type {.cls",
-            "{sf::st_geometry_type(observations, by_geometry = FALSE)}}")
-      )
-    )
-   }
-
-  ## number of points in sf object and the coords_uncertainty_meters must be the
-  ## same when coords_uncertainty_meters is larger than 1
-  if (length(coords_uncertainty_meters) != 1) {
+  # 2. Other checks
+  # Number of observations and values in coords_uncertainty_meters must be the
+  # same when number of values is larger than 1
+  if (length(coords_uncertainty_meters) > 1) {
     size_match <- length(coords_uncertainty_meters) == nrow(observations)
-
-    if (!size_match) {
-      cli::cli_abort(
-        c(
-          paste("{.var coords_uncertainty_meters} has diferent length than the",
-                "number of rows in {.var observations}"),
-          "x" = paste("You've supplied {.var coords_uncertainty_meters} of",
-                      "length {length(coords_uncertainty_meters)}",
-                      "but {.var observations} has {nrow(observations)} rows.")
-        )
-     )
-    }
+    error_message = paste(
+      "Number of values in `coords_uncertainty_meters` differs from the number",
+      "of observations."
+    )
+    do.call(stopifnot, stats::setNames(list(size_match), error_message))
   }
+  ### End checks
 
   observations$coordinateUncertaintyInMeters <- coords_uncertainty_meters
 

tests/testthat/test-add_coordinate_uncertainty.R

@@ -75,18 +75,11 @@ test_that(paste("add_coordinate_uncertainty() returns error on wrong length of",
       observations_sf,
       coords_uncertainty_meters = rep(1234, n_observations + 1)
     ),
-    regexp = paste("`coords_uncertainty_meters` has diferent length than the",
-                   "number of rows in `observations`"),
-    fixed = TRUE
-  )
-
-  expect_error(
-    add_coordinate_uncertainty(
-      observations_sf,
-      coords_uncertainty_meters = rep(1234, n_observations + 1)
+    regexp = paste(
+      "Number of values in `coords_uncertainty_meters` differs from the number",
+      "of observations."
     ),
-    regexp = paste("You've supplied `coords_uncertainty_meters` of length 8",
-                   "but `observations` has 7 rows.")
+    fixed = TRUE
   )
 })
 
@@ -97,12 +90,7 @@ test_that(paste("add_coordinate_uncertainty() returns error on non sf",
   # Use an expectation per line of the error.
   expect_error(
     add_coordinate_uncertainty(not_an_sf_object),
-    regexp = "`observations` must be an object of class 'sf'",
-    fixed = TRUE
-  )
-  expect_error(
-    add_coordinate_uncertainty(not_an_sf_object),
-    regexp = "You've supplied an object of class <data.frame>",
+    regexp = "`observations` must be an sf object with POINT geometry.",
     fixed = TRUE
   )
 })
@@ -128,7 +116,7 @@ test_that(paste("add_coordinate_uncertainty() returns error when coordinate",
       observations_sf,
       coords_uncertainty_meters = "not a number"
     ),
-    regexp = "coords_uncertainty_meters must be a numeric value",
+    regexp = "`coords_uncertainty_meters` must be  numeric vector.",
     fixed = TRUE
   )
 })