From 67522720c7be70e62351cf1667bbf6bafdcf5258 Mon Sep 17 00:00:00 2001 From: Jack Talboys <42234641+jtalboys@users.noreply.github.com> Date: Wed, 2 Oct 2024 05:08:06 +0100 Subject: [PATCH] Add columns `fmt_fn`, `warning`, and `errors` to `ard_attributes` output (#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 :white_check_mark: - [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 :white_check_mark: - [x] Approve Pull Request - [x] Merge the PR. Please use "Squash and merge" or "Rebase and merge". --------- Co-authored-by: Daniel Sjoberg --- NEWS.md | 2 ++ R/ard_attributes.R | 18 +++++++++++++++++- tests/testthat/_snaps/ard_attributes.md | 18 +++++++++++++----- tests/testthat/_snaps/mock.md | 14 ++++++++------ tests/testthat/_snaps/print.md | 2 +- tests/testthat/test-ard_attributes.R | 19 +++++++++++++++++++ 6 files changed, 60 insertions(+), 13 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7dfb00842..698126360 100644 --- 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 index cb2dd808c..622fb293f 100644 --- 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 index 5f8a70512..e690589a3 100644 --- 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 index ffe93c0bc..4e64ed691 100644 --- 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 + 2 AGE attribut… class Variable… logical NULL + 3 BMIBL attribut… label Variable… Baseline… + 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 index de1781e0e..b9b5beb23 100644 --- 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 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 index fe9ef0b14..2cf2a3a92 100644 --- 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 ." ) }) + +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") + ) + ) +})