Add columns fmt_fn, warning, and errors to ard_attributes out…

…put (#343) **What changes are proposed in this pull request?** * Add columns `fmt_fn`, `warning`, and `errors` to `ard_attributes()` output (#327) Provide more detail here as needed. closes #327 Please let me know if there is anything else to change here. I'm not 100% sure I'm setting the `fmt_fn` column right? Also had a look at the docs for `ard_attributes()` to see if any changes were required but they only talk about the added attributes, don't mention the columns of the output. -------------------------------------------------------------------------------- Pre-review Checklist (if item does not apply, mark is as complete) - [x] **All** GitHub Action workflows pass with a ✅ - [x] PR branch has pulled the most recent updates from master branch: `usethis::pr_merge_main()` - [x] If a bug was fixed, a unit test was added. - [x] Code coverage is suitable for any new functions/features (generally, 100% coverage for new code): `devtools::test_coverage()` - [x] Request a reviewer Reviewer Checklist (if item does not apply, mark is as complete) - [x] If a bug was fixed, a unit test was added. - [x] Run `pkgdown::build_site()`. Check the R console for errors, and review the rendered website. - [x] Code coverage is suitable for any new functions/features: `devtools::test_coverage()` When the branch is ready to be merged: - [x] Update `NEWS.md` with the changes from this pull request under the heading "`# cards (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). - [x] **All** GitHub Action workflows pass with a ✅ - [x] Approve Pull Request - [x] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Co-authored-by: Daniel Sjoberg <[email protected]>
insightsengineering · Oct 2, 2024 · 6752272 · 6752272
1 parent 920ab61
commit 6752272
Show file tree

Hide file tree

Showing 6 changed files with 60 additions and 13 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # cards 0.2.2.9015
 
+* Add columns `'fmt_fn'`, `'warning'`, and `'errors'` to `ard_attributes()` output. (#327)
+
 * Add checks for factors with no levels, or any levels that are `NA` into `ard_*` functions (#255) 
 
 * Any rows with `NA` or `NaN` values in the `.by` columns specified in `ard_stack()` are now removed from all calculations. (#320)

diff --git a/R/ard_attributes.R b/R/ard_attributes.R
@@ -57,6 +57,19 @@ ard_attributes.data.frame <- function(data,
     return(dplyr::tibble() |> as_card())
   }
 
+
+  # check label is a named list ------------------------------------------------
+  if (!is_empty(label)) {
+    if (!is.list(label) || !is_named(label) || some(label, \(x) !is_string(x))) {
+      cli::cli_abort(
+        "The {.arg label} argument must be a named list with each element a string.",
+        call = get_cli_abort_call()
+      )
+    }
+  }
+
+
+
   variables |>
     lapply(
       FUN = function(y) {
@@ -80,7 +93,10 @@ ard_attributes.data.frame <- function(data,
         .data$stat_name %in% "class" ~ "Variable Class",
         TRUE ~ .data$stat_name
       ),
-      context = "attributes"
+      context = "attributes",
+      fmt_fn = ifelse(.data$stat_name %in% "label", list(as.character), list(NULL)),
+      warning = list(NULL),
+      error = list(NULL)
     ) |>
     cards::tidy_ard_column_order() |>
     as_card()

diff --git a/tests/testthat/_snaps/ard_attributes.md b/tests/testthat/_snaps/ard_attributes.md
@@ -5,9 +5,17 @@
       attr(df$var1, "label") <- "Lowercase Letters"
       as.data.frame(ard_attributes(df, variables = everything(), label = list(var2 = "UPPERCASE LETTERS")))
     Output
-        variable    context stat_name     stat_label              stat
-      1     var1 attributes     label Variable Label Lowercase Letters
-      2     var1 attributes     class Variable Class         character
-      3     var2 attributes     label Variable Label UPPERCASE LETTERS
-      4     var2 attributes     class Variable Class         character
+        variable    context stat_name     stat_label              stat                     fmt_fn warning error
+      1     var1 attributes     label Variable Label Lowercase Letters .Primitive("as.character")    NULL  NULL
+      2     var1 attributes     class Variable Class         character                       NULL    NULL  NULL
+      3     var2 attributes     label Variable Label UPPERCASE LETTERS .Primitive("as.character")    NULL  NULL
+      4     var2 attributes     class Variable Class         character                       NULL    NULL  NULL
+
+# ard_attributes() requires label as a named list
+
+    Code
+      ard_attributes(ADSL[c("AGE", "AGEGR1")], label = list("test"))
+    Condition
+      Error in `ard_attributes()`:
+      ! The `label` argument must be a named list with each element a string.
 
diff --git a/tests/testthat/_snaps/mock.md b/tests/testthat/_snaps/mock.md
@@ -131,13 +131,15 @@
     Code
       mock_attributes(label = list(AGE = "Age", BMIBL = "Baseline BMI"))
     Message
-      {cards} data frame: 4 x 5
+      {cards} data frame: 4 x 8
     Output
-        variable   context stat_name stat_label      stat
-      1      AGE attribut…     label  Variable…       Age
-      2      AGE attribut…     class  Variable…   logical
-      3    BMIBL attribut…     label  Variable… Baseline…
-      4    BMIBL attribut…     class  Variable…   logical
+        variable   context stat_name stat_label      stat fmt_fn
+      1      AGE attribut…     label  Variable…       Age   <fn>
+      2      AGE attribut…     class  Variable…   logical   NULL
+      3    BMIBL attribut…     label  Variable… Baseline…   <fn>
+      4    BMIBL attribut…     class  Variable…   logical   NULL
+    Message
+      i 2 more variables: warning, error
 
 # mock_attributes() messaging
 

diff --git a/tests/testthat/_snaps/print.md b/tests/testthat/_snaps/print.md
@@ -90,7 +90,7 @@
       {cards} data frame: 4 x 8
     Output
         variable   context stat_name stat_label                         stat fmt_fn
-      1      mpg attribut…     label  Variable…                          mpg   NULL
+      1      mpg attribut…     label  Variable…                          mpg   <fn>
       2      mpg attribut…     class  Variable…                      numeric   NULL
       3      mpg continuo…      mean       Mean                       20.091      1
       4      mpg continuo…      vcov       vcov 1.265, -1.265, -1.265, 3.113      1

diff --git a/tests/testthat/test-ard_attributes.R b/tests/testthat/test-ard_attributes.R
@@ -1,4 +1,7 @@
+skip_if_not(is_pkg_installed("withr"))
+
 test_that("ard_attributes() works", {
+  withr::local_options(list(width = 120))
   expect_snapshot({
     df <- dplyr::tibble(var1 = letters, var2 = LETTERS)
     attr(df$var1, "label") <- "Lowercase Letters"
@@ -14,3 +17,19 @@ test_that("ard_attributes() errors when there is no dataframe", {
     "There is no method for objects of class <character>."
   )
 })
+
+test_that("ard_attributes() follows ard structure", {
+  expect_silent(
+    ard_attributes(ADSL[c("AGE", "AGEGR1")]) |>
+      check_ard_structure(method = FALSE)
+  )
+})
+
+test_that("ard_attributes() requires label as a named list", {
+  expect_snapshot(
+    error = TRUE,
+    ard_attributes(ADSL[c("AGE", "AGEGR1")],
+      label = list("test")
+    )
+  )
+})