From 7f9ed34c03146157a65940588cb85e12aef57a20 Mon Sep 17 00:00:00 2001
From: Daniel Sjoberg <danield.sjoberg@gmail.com>
Date: Mon, 8 Jul 2024 08:39:42 -0700
Subject: [PATCH] Added check for protected names in
 `ard_categorical.survey.design()` (#182)

**What changes are proposed in this pull request?**
* Adding a check for variables named `variable` and `variable_level` in
the `ard_categorical(by)` argument.

**Reference GitHub issue associated with pull request.** _e.g., 'closes
#<issue number>'_
Part of #173


--------------------------------------------------------------------------------

Pre-review Checklist (if item does not apply, mark is as complete)
- [ ] **All** GitHub Action workflows pass with a :white_check_mark:
- [ ] PR branch has pulled the most recent updates from master branch:
`usethis::pr_merge_main()`
- [ ] If a bug was fixed, a unit test was added.
- [ ] If a new `ard_*()` function was added, it passes the ARD
structural checks from `cards::check_ard_structure()`.
- [ ] If a new `ard_*()` function was added, `set_cli_abort_call()` has
been set.
- [ ] If a new `ard_*()` function was added and it depends on another
package (such as, `broom`), `is_pkg_installed("broom", reference_pkg =
"cardx")` has been set in the function call and the following added to
the roxygen comments: `@examplesIf
do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom"",
reference_pkg = "cardx"))`
- [ ] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`

Reviewer Checklist (if item does not apply, mark is as complete)

- [ ] If a bug was fixed, a unit test was added.
- [ ] Code coverage is suitable for any new functions/features:
`devtools::test_coverage()`

When the branch is ready to be merged:
- [ ] Update `NEWS.md` with the changes from this pull request under the
heading "`# cardx (development version)`". If there is an issue
associated with the pull request, reference it in parentheses at the end
update (see `NEWS.md` for examples).
- [ ] **All** GitHub Action workflows pass with a :white_check_mark:
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".
---
 R/ard_categorical.survey.design.R             |  9 +++++++
 .../_snaps/ard_categorical.survey.design.md   |  8 ++++++
 .../test-ard_categorical.survey.design.R      | 26 +++++++++++++++++++
 3 files changed, 43 insertions(+)

diff --git a/R/ard_categorical.survey.design.R b/R/ard_categorical.survey.design.R
index 1827970ec..63cb9b0c8 100644
--- a/R/ard_categorical.survey.design.R
+++ b/R/ard_categorical.survey.design.R
@@ -117,6 +117,15 @@ ard_categorical.survey.design <- function(data,
     }
   )
 
+  # return note about column names that result in errors -----------------------
+  if (any(by %in% c("variable", "variable_level"))) {
+    cli::cli_abort(
+      "The {.arg by} argument cannot include variables named {.val {c('variable', 'variable_level')}}.",
+      call = get_cli_abort_call()
+    )
+  }
+
+
   # calculate counts -----------------------------------------------------------
   # this tabulation accounts for unobserved combinations
   svytable_counts <- .svytable_counts(data, variables, by, denominator)
diff --git a/tests/testthat/_snaps/ard_categorical.survey.design.md b/tests/testthat/_snaps/ard_categorical.survey.design.md
index c72bebd09..55c7abb1d 100644
--- a/tests/testthat/_snaps/ard_categorical.survey.design.md
+++ b/tests/testthat/_snaps/ard_categorical.survey.design.md
@@ -28,3 +28,11 @@
       ! Column "Class" is all missing and cannot be tabulated.
       i Only columns of class <logical> and <factor> can be tabulated when all values are missing.
 
+# ard_categorical.survey.design(by) messages about protected names
+
+    Code
+      ard_categorical(svy_mtcars, by = variable, variables = gear)
+    Condition
+      Error in `ard_categorical()`:
+      ! The `by` argument cannot include variables named "variable" and "variable_level".
+
diff --git a/tests/testthat/test-ard_categorical.survey.design.R b/tests/testthat/test-ard_categorical.survey.design.R
index 7ba6333e9..680032724 100644
--- a/tests/testthat/test-ard_categorical.survey.design.R
+++ b/tests/testthat/test-ard_categorical.survey.design.R
@@ -1172,3 +1172,29 @@ test_that("ard_categorical.survey.design() works with variables with only 1 leve
   )
   expect_invisible(cards::check_ard_structure(ard_svy_cat_cell, method = FALSE))
 })
+
+
+test_that("ard_categorical.survey.design(by) messages about protected names", {
+  svy_mtcars <-
+    survey::svydesign(
+      ids = ~1,
+      data = mtcars |>
+        dplyr::mutate(
+          variable = am,
+          variable_level = cyl,
+          by = am,
+          by_level = cyl
+        ),
+      weights = ~1
+    )
+
+  expect_snapshot(
+    error = TRUE,
+    ard_categorical(svy_mtcars, by = variable, variables = gear)
+  )
+
+  expect_error(
+    ard_categorical(svy_mtcars, by = variable_level, variables = gear),
+    'The `by` argument cannot include variables named "variable" and "variable_level".'
+  )
+})