diff --git a/R/rename_ard_columns.R b/R/rename_ard_columns.R index ca2cc4be3..7fdb8b3c0 100644 --- a/R/rename_ard_columns.R +++ b/R/rename_ard_columns.R @@ -3,7 +3,7 @@ #' Rename the grouping and variable columns to their original column names. #' #' @param x (`data.frame`)\cr -#' an ARD data frame of class 'card' +#' an ARD data frame of class `'card'` or `'card_unlisted'` #' @param columns ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' columns to rename, e.g. selecting columns `c('group1', 'group2', 'variable')` #' will rename `'group1_level'` to the name of the variable found in `'group1'`. @@ -23,7 +23,7 @@ #' of retaining the label. Default is `TRUE`. #' @param unlist `r lifecycle::badge("deprecated")` #' -#' @return data frame +#' @return a data frame of class `'card_renamed'` #' @export #' #' @examples @@ -56,7 +56,7 @@ rename_ard_columns <- function(x, } set_cli_abort_call() check_not_missing(x) - check_class(x, "card") + check_class(x, c("card", "card_unlisted")) process_selectors(x, columns = {{ columns }}) check_scalar(fill) check_scalar_logical(fct_as_chr) @@ -96,7 +96,8 @@ rename_ard_columns <- function(x, ) } - x |> + result <- + x |> dplyr::mutate(...ard_row_order... = dplyr::row_number()) |> dplyr::group_by(dplyr::pick(all_of(column_names))) |> dplyr::group_map( @@ -143,4 +144,9 @@ rename_ard_columns <- function(x, unlist() ) ) + + # remove 'card' class: renamed data no longer satisfies the ARD contract ----- + class(result) <- c("card_renamed", setdiff(class(result), c("card", "card_unlisted", "card_renamed"))) + + result } diff --git a/R/unlist_ard_columns.R b/R/unlist_ard_columns.R index 57d959a82..4a514fa0f 100644 --- a/R/unlist_ard_columns.R +++ b/R/unlist_ard_columns.R @@ -15,7 +15,7 @@ #' of retaining the label. Default is `TRUE`. #' #' -#' @returns a data frame +#' @returns a data frame of class `'card_unlisted'` #' @export #' #' @examples @@ -69,6 +69,8 @@ unlist_ard_columns <- function(x, x[[var]] <- var_unlisted } - # return unlisted object ----------------------------------------------------- + # remove 'card' class: unlisted data no longer satisfies the ARD contract --- + class(x) <- c("card_unlisted", setdiff(class(x), c("card", "card_unlisted", "card_renamed"))) + x } diff --git a/tests/testthat/test-rename_ard_columns.R b/tests/testthat/test-rename_ard_columns.R index 10261ae88..56acf2008 100644 --- a/tests/testthat/test-rename_ard_columns.R +++ b/tests/testthat/test-rename_ard_columns.R @@ -1,3 +1,22 @@ +test_that("rename_ard_columns() returns 'card_renamed' class", { + result <- + ADSL |> + ard_tabulate(by = ARM, variables = AGEGR1) |> + rename_ard_columns() + + expect_s3_class(result, "card_renamed") + expect_false(inherits(result, "card")) +}) + +test_that("rename_ard_columns() accepts 'card_unlisted' input", { + expect_silent( + ADSL |> + ard_tabulate(by = ARM, variables = AGEGR1) |> + unlist_ard_columns() |> + rename_ard_columns() + ) +}) + test_that("rename_ard_columns(columns)", { expect_equal( ADSL |> diff --git a/tests/testthat/test-unlist_ard_columns.R b/tests/testthat/test-unlist_ard_columns.R index 28b20c448..5b9549199 100644 --- a/tests/testthat/test-unlist_ard_columns.R +++ b/tests/testthat/test-unlist_ard_columns.R @@ -1,3 +1,12 @@ +test_that("unlist_ard_columns() returns 'card_unlisted' class", { + result <- + ard_tabulate(ADSL, variables = AGEGR1) |> + unlist_ard_columns() + + expect_s3_class(result, "card_unlisted") + expect_false(inherits(result, "card")) +}) + test_that("unlist_ard_columns()", { expect_equal( ard_tabulate(ADSL, variables = AGEGR1) |>