Updated order of grouping variables in ARDs (#394)

In most cases, the order of the grouping variables doesn't really
matter. Two exceptions are the hierarchical ARD and the results from
`ard_strata()`. Rather than changing all the ARDs to have the grouping
begin with the largest group (which is counterintuitive for the
hierarchical ARDs), I think we can just change `ard_strata()` results.

**What changes are proposed in this pull request?**
* Added the `all_ard_group_n(types)` argument to allow separate
selection of `groupX` and `groupX_level` columns.
* Added the `tidy_ard_column_order(group_order)` argument that allows
users to specify whether the grouping variables are listed in ascending
order (the default) or descending order. The output of `ard_strata()`
now calls `tidy_ard_column_order(group_order="descending")`.

I made some other small changes in the hierarchical functions that don't
use positional matching of the columns, and rather relies on the column
names. I think it's just a bit more robust to potential changes in the
future.

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


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

Pre-review Checklist (if item does not apply, mark is as complete)
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] 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.
- [ ] Code coverage is suitable for any new functions/features
(generally, 100% coverage for new code): `devtools::test_coverage()`
- [ ] Request a reviewer

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

- [ ] If a bug was fixed, a unit test was added.
- [ ] Run `pkgdown::build_site()`. Check the R console for errors, and
review the rendered website.
- [ ] 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 "`# 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).
- [ ] **All** GitHub Action workflows pass with a ✅
- [ ] Approve Pull Request
- [ ] Merge the PR. Please use "Squash and merge" or "Rebase and merge".

_Optional Reverse Dependency Checks_:

Install `checked` with `pak::pak("Genentech/checked")` or
`pak::pak("checked")`

```shell
# Check dev versions of `cardx`, `gtsummary`, and `tfrmt` which are in the `ddsjoberg` R Universe
Rscript -e "options(checked.check_envvars = c(NOT_CRAN = TRUE)); checked::check_rev_deps(path = '.', n = parallel::detectCores() - 2L, repos = c('https://ddsjoberg.r-universe.dev', 'https://cloud.r-project.org'))"

# Check CRAN reverse dependencies but run tests skipped on CRAN
Rscript -e "options(checked.check_envvars = c(NOT_CRAN = TRUE)); checked::check_rev_deps(path = '.', n = parallel::detectCores() - 2, repos = 'https://cloud.r-project.org')"

# Check CRAN reverse dependencies in a CRAN-like environment
Rscript -e "options(checked.check_envvars = c(NOT_CRAN = FALSE), checked.check_build_args = '--as-cran'); checked::check_rev_deps(path = '.', n = parallel::detectCores() - 2, repos = 'https://cloud.r-project.org')"
```

Author: ddsjoberg

NEWS.md

@@ -1,12 +1,22 @@
 # cards 0.4.0.9032
 
-* Results are now sorted in a consistent manner, by descending groups and strata. (#342, #326)
+## New Features and Functions
 
 * Added functions `rename_ard_groups_shift()` and `rename_ard_groups_reverse()` for renaming the grouping variables in the ARD. (#344)
 
+* Added an option to specify the default rounding in the package: `cards.round_type`. See `?cards.options` for details. (#384)
+
 * Added the `print_ard_conditions(condition_type)` argument, which allows users to select to return conditions as messages (the default), or have warnings returned as warnings and errors as errors. (#386)
 
-* Added an option to specify the default rounding in the package: `cards.round_type`. See `?cards.options` for details. (#384)
+* Added the `all_ard_group_n(types)` argument to allow separate selection of `groupX` and `groupX_level` columns.
+
+* Added the `tidy_ard_column_order(group_order)` argument that allows users to specify whether the grouping variables are listed in ascending order (the default) or descending order. The output of `ard_strata()` now calls `tidy_ard_column_order(group_order="descending")`.
+
+## Other Updates
+
+* Results are now sorted in a consistent manner, by descending groups and strata. (#342, #326)
+
+## Lifecycle Updates
 
 * Function `label_cards()` has been renamed to `label_round()`, which more clearly communicates that is returns a rounding function.
 

R/ard_hierarchical.R

@@ -135,7 +135,7 @@ ard_hierarchical.data.frame <- function(data,
     )
 
   # renaming columns -----------------------------------------------------------
-  df_result <- .rename_last_group_as_variable(df_result)
+  df_result <- .rename_last_group_as_variable(df_result, by = by, variables = variables)
 
   # return ard -----------------------------------------------------------------
   df_result |>
@@ -177,7 +177,7 @@ ard_hierarchical_count.data.frame <- function(data,
     fmt_fn = fmt_fn,
     stat_label = stat_label
   ) |>
-    .rename_last_group_as_variable() |>
+    .rename_last_group_as_variable(by = by, variables = variables) |>
     dplyr::mutate(context = "hierarchical_count") |>
     as_card()
 }
@@ -196,15 +196,12 @@ ard_hierarchical_count.data.frame <- function(data,
 #' @examples
 #' data <- data.frame(x = 1, y = 2, group1 = 3, group2 = 4)
 #'
-#' cards:::.rename_last_group_as_variable(data)
-.rename_last_group_as_variable <- function(df_result) {
-  df_result <- dplyr::select(df_result, -all_ard_variables())
-
-  last_two_grouping_columns <-
-    dplyr::select(df_result, all_ard_groups()) |>
-    names() |>
-    utils::tail(n = 2L) |>
-    stats::setNames(c("variable", "variable_level"))
-
-  dplyr::rename(df_result, !!!last_two_grouping_columns)
+#' cards:::.rename_last_group_as_variable(data, by = "ARM", variables = "AESOC")
+.rename_last_group_as_variable <- function(df_result, by, variables) {
+  df_result |>
+    dplyr::select(-all_ard_variables()) |>
+    dplyr::rename(
+      variable = all_ard_group_n(n = length(c(by, variables)), types = "names"),
+      variable_level = all_ard_group_n(n = length(c(by, variables)), types = "levels")
+    )
 }

R/ard_strata.R

@@ -83,5 +83,5 @@ ard_strata <- function(.data, .by = NULL, .strata = NULL, .f, ...) {
   df_nested_data |>
     tidyr::unnest(cols = all_of("ard")) |>
     as_card() |>
-    tidy_ard_column_order()
+    tidy_ard_column_order(group_order = "descending")
 }

R/selectors.R

@@ -63,9 +63,15 @@ all_ard_variables <- function(types = c("names", "levels")) {
 
 #' @export
 #' @rdname selectors
-all_ard_group_n <- function(n) {
+all_ard_group_n <- function(n, types = c("names", "levels")) {
+  types <- arg_match(types, values = c("names", "levels"), multiple = TRUE)
+
+  group_cols <- character(0L)
+  if ("names" %in% types) group_cols <- c(group_cols, paste0("group", n)) # styler: off
+  if ("levels" %in% types) group_cols <- c(group_cols, paste0("group", n, "_level")) # styler: off
+
   check_integerish(n)
-  any_of(sort(c(paste0("group", n), paste0("group", n, "_level"))))
+  any_of(sort(group_cols))
 }
 
 #' @export

R/tidy_ard_order.R

@@ -6,10 +6,15 @@
 #' - `tidy_ard_column_order()` relocates columns of the ARD to the standard order.
 #'
 #' - `tidy_ard_row_order()` orders rows of ARD according to groups and
-#'   strata, while retaining the order of the input ARD.
+#'   strata (group 1, then group2, etc), while retaining the column order of the input ARD.
 #'
 #' @param x (`data.frame`)\cr
 #'   an ARD data frame of class 'card'
+#' @param group_order (`string`)\cr
+#'   specifies the ordering of the grouping variables.
+#'   Must be one of `c("ascending", "descending")`.
+#'   Default is `"ascending"`, where grouping variables begin with `"group1"` variables,
+#'   followed by `"group2"` variables, etc.
 #'
 #' @return an ARD data frame of class 'card'
 #' @name tidy_ard_order
@@ -28,14 +33,23 @@ NULL
 
 #' @rdname tidy_ard_order
 #' @export
-tidy_ard_column_order <- function(x) {
+tidy_ard_column_order <- function(x, group_order = c("ascending", "descending")) {
   set_cli_abort_call()
+  group_order <- arg_match(group_order)
 
-  group_cols <- dplyr::select(x, all_ard_groups()) |>
-    names() |>
-    sort()
-  group_cols <- group_cols[order(str_extract_all(group_cols, "\\d+") |> unlist() |> as.integer())]
+  # specify the ordering the grouping variables
+  group_cols <-
+    data.frame(colname = dplyr::select(x, all_ard_groups()) |> names()) |>
+    dplyr::arrange(
+      case_switch(
+        group_order == "ascending" ~ as.integer(unlist(str_extract_all(.data$colname, "\\d+"))),
+        group_order == "descending" ~ dplyr::desc(as.integer(unlist(str_extract_all(.data$colname, "\\d+"))))
+      ),
+      .data$colname
+    ) |>
+    dplyr::pull("colname")
 
+  # selecting the columns in the tidy order
   dplyr::select(
     x,
     all_of(group_cols),
@@ -57,10 +71,15 @@ tidy_ard_row_order <- function(x) {
 
   # get columns that dictate ordering
   cols <- x |>
-    dplyr::select(
-      all_ard_groups(c("names", "levels"))
-    ) |>
+    dplyr::select(all_ard_groups(c("names", "levels"))) |>
     names()
+  if (!is_empty(cols)) {
+    max_group_n <- as.integer(unlist(str_extract_all(cols, "\\d+"))) |> max()
+    cols <-
+      map(seq_len(max_group_n), ~ c(paste0("group", .x), paste0("group", .x, "_level"))) |>
+      unlist() |>
+      intersect(cols)
+  }
 
   # perform the ordering
   x |> dplyr::arrange(across(all_of(cols), .fns = function(x) match(x, unique(x))))