Error informatively when xobs_only() arguments are named or unknown

R/xobs-only.R

@@ -1,6 +1,9 @@
 #' Generate Observed Combinations Only
 #'
-#' @param ... One or more variables to generate combinations for.
+#' @param ... One or more unnamed variables in `.data` to generate observed
+#'   combinations for. Naming an argument is an error as a new column has no
+#'   observed combinations to preserve; use a named argument to [xnew_data()]
+#'   instead.
 #' @param .length_out A count to override the default length of sequences.
 #' @inheritParams xcast
 #' @return A tibble of the observed combinations of the variables.
@@ -19,6 +22,15 @@
 xobs_only <- function(..., .length_out = NULL, .data = xnew_data_env$data) {
   quos <- enquos(...)
 
+  named <- names2(quos)[nzchar(names2(quos))]
+  if (length(named)) {
+    err(
+      "`xobs_only()` arguments must not be named (",
+      cc(named, " and "),
+      ") as observed combinations must refer to columns of `.data`"
+    )
+  }
+
   translated <- map(quos, quo_translate_xobs_only, .length_out)
 
   out <- semi_crossing(!!!translated)
@@ -46,5 +58,14 @@ semi_crossing <- function(..., .data = xnew_data_env$data) {
   }
 
   out <- tidyr::crossing(...)
-  dplyr::semi_join(out, .data, by = intersect(names(out), names(.data)))
+
+  missing <- setdiff(names(out), names(.data))
+  if (length(missing)) {
+    err(
+      "`xobs_only()` arguments must refer to columns of `.data` (unrecognised: ",
+      cc(missing, " and "),
+      ")"
+    )
+  }
+  dplyr::semi_join(out, .data, by = names(out))
 }

tests/testthat/_snaps/xobs-only.md

@@ -0,0 +1,23 @@
+# xobs_only errors informatively for named and unknown arguments (#111)
+
+    Code
+      xnew_data(data, xobs_only(z = b))
+    Condition
+      Error:
+      ! `xobs_only()` arguments must not be named ('z') as observed combinations must refer to columns of `.data`.
+    Code
+      xnew_data(data, xobs_only(a, z = new_seq(b, .length_out = 2)))
+    Condition
+      Error:
+      ! `xobs_only()` arguments must not be named ('z') as observed combinations must refer to columns of `.data`.
+    Code
+      xnew_data(data, xobs_only(b = b))
+    Condition
+      Error:
+      ! `xobs_only()` arguments must not be named ('b') as observed combinations must refer to columns of `.data`.
+    Code
+      xnew_data(data, xobs_only(new_seq(b, .length_out = 2)))
+    Condition
+      Error:
+      ! `xobs_only()` arguments must refer to columns of `.data` (unrecognised: 'new_seq(b, .length_out = 2)').
+

tests/testthat/test-xobs-only.R

@@ -0,0 +1,32 @@
+test_that("xobs_only preserves observed combinations", {
+  data <- tibble::tibble(
+    a = c(1.5, 2.5, 3.5),
+    b = factor(c("a", "a", "b"), levels = c("a", "b", "c"))
+  )
+
+  new_data <- xnew_data(data, xobs_only(a, b))
+  expect_identical(new_data$a, data$a)
+  expect_identical(new_data$b, data$b)
+
+  new_data <- xnew_data(data, xobs_only(a, xnew_seq(b, .length_out = 1)))
+  expect_identical(new_data$a, c(1.5, 2.5))
+  expect_identical(new_data$b, factor(c("a", "a"), levels = c("a", "b", "c")))
+})
+
+test_that("xobs_only errors informatively for named and unknown arguments (#111)", {
+  data <- tibble::tibble(
+    a = 1:5 + 0.5,
+    b = factor(letters[1:5])
+  )
+
+  expect_snapshot(error = TRUE, {
+    xnew_data(data, xobs_only(z = b))
+    xnew_data(data, xobs_only(a, z = new_seq(b, .length_out = 2)))
+    xnew_data(data, xobs_only(b = b))
+    xnew_data(data, xobs_only(new_seq(b, .length_out = 2)))
+  })
+
+  # naming the whole xobs_only() call still creates a new column
+  new_data <- xnew_data(data, z = xobs_only(b))
+  expect_named(new_data, c("a", "b", "z"))
+})