unique_check() -> check_unique() (#426)

* `unique_check()` -> `check_unique()` + improvements

* Update R/misc.R

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

---------

Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com>

Author: hfrick

R/misc.R

@@ -297,3 +297,21 @@ check_frac_range <- function(x, ..., arg = caller_arg(x), call = caller_env()) {
     call = call
   )
 }
+
+check_unique <- function(x, ..., arg = caller_arg(x), call = caller_env()) {
+  check_dots_empty()
+  x2 <- x[!is.na(x)]
+  is_dup <- duplicated(x2)
+  if (!any(is_dup)) {
+    return(invisible(NULL))
+  }
+
+  dup_list <- x2[is_dup]
+  cli::cli_abort(
+    c(
+      x = "{.arg {arg}} must have unique values.",
+      i = "Duplicates: {.val {dup_list}}"
+    ),
+    call = call
+  )
+}

R/parameters.R

@@ -66,25 +66,6 @@ parameters.list <- function(x, ...) {
   )
 }
 
-unique_check <- function(x, ..., call = caller_env()) {
-  check_dots_empty()
-  x2 <- x[!is.na(x)]
-  is_dup <- duplicated(x2)
-  if (any(is_dup)) {
-    dup_list <- x2[is_dup]
-    cl <- match.call()
-
-    cli::cli_abort(
-      c(
-        x = "Element {.field {deparse(cl$x)}} should have unique values.",
-        i = "Duplicates exist for {cli::qty(dup_list)} item{?s}: {dup_list}"
-      ),
-      call = call
-    )
-  }
-  invisible(TRUE)
-}
-
 param_or_na <- function(x) {
   inherits(x, "param") | all(is.na(x))
 }
@@ -135,7 +116,7 @@ parameters_constr <- function(
 
   check_character(name, call = call)
   check_character(id, call = call)
-  unique_check(id, call = call)
+  check_unique(id, call = call)
   check_character(source, call = call)
   check_character(component, call = call)
   check_character(component_id, call = call)

tests/testthat/_snaps/misc.md

@@ -174,6 +174,34 @@
       Error:
       ! `c(0.1, NA)` must be a numeric vector of length 2 with values between 0 and 1, not a double vector.
 
+# check_unique() errors on duplicates
+
+    Code
+      check_unique(c("a", "a"))
+    Condition
+      Error:
+      x `c("a", "a")` must have unique values.
+      i Duplicates: "a"
+
+---
+
+    Code
+      check_unique(c("a", "b", "a", "b"))
+    Condition
+      Error:
+      x `c("a", "b", "a", "b")` must have unique values.
+      i Duplicates: "a" and "b"
+
+---
+
+    Code
+      my_ids <- c("x", "x")
+      check_unique(my_ids)
+    Condition
+      Error:
+      x `my_ids` must have unique values.
+      i Duplicates: "x"
+
 # vctrs-helpers-parameters
 
     Code

tests/testthat/_snaps/parameters.md

@@ -13,8 +13,8 @@
       parameters_constr(ab, id = c("a", "a"), ab, ab, ab)
     Condition
       Error:
-      x Element id should have unique values.
-      i Duplicates exist for item: a
+      x `id` must have unique values.
+      i Duplicates: "a"
 
 ---
 
@@ -58,8 +58,8 @@
       parameters(list(a = mtry(), a = penalty()))
     Condition
       Error in `parameters()`:
-      x Element id should have unique values.
-      i Duplicates exist for item: a
+      x `id` must have unique values.
+      i Duplicates: "a"
 
 ---
 

tests/testthat/test-misc.R

@@ -91,6 +91,27 @@ test_that("check_frac_range()", {
   expect_snapshot(error = TRUE, check_frac_range(c(0.1, NA)))
 })
 
+test_that("check_unique() passes with unique values", {
+  expect_null(check_unique(c("a", "b", "c")))
+  expect_null(check_unique(c(1, 2, 3)))
+  expect_null(check_unique(character()))
+})
+
+test_that("check_unique() ignores NA values", {
+  expect_null(check_unique(c("a", NA, "b")))
+  expect_null(check_unique(c(NA, NA, NA)))
+  expect_null(check_unique(c("a", NA, NA, "b")))
+})
+
+test_that("check_unique() errors on duplicates", {
+  expect_snapshot(error = TRUE, check_unique(c("a", "a")))
+  expect_snapshot(error = TRUE, check_unique(c("a", "b", "a", "b")))
+  expect_snapshot(error = TRUE, {
+    my_ids <- c("x", "x")
+    check_unique(my_ids)
+  })
+})
+
 test_that("vctrs-helpers-parameters", {
   expect_false(dials:::is_parameters(2))
   expect_snapshot(