adding group rename functions

NAMESPACE

@@ -75,6 +75,8 @@ export(print_ard_conditions)
 export(process_formula_selectors)
 export(process_selectors)
 export(rename_ard_columns)
+export(rename_ard_groups_reverse)
+export(rename_ard_groups_shift)
 export(replace_null_statistic)
 export(round5)
 export(shuffle_ard)

R/rename_ard_groups.R

@@ -0,0 +1,112 @@
+#' Rename ARD Group Columns
+#'
+#' Functions for renaming group columns names in ARDs.
+#'
+#' @param x (`data.frame`)\cr
+#'  an ARD data frame of class 'card'.
+#' @param shift (`integer`)\cr
+#'  an integer specifying how many values to shift the group IDs,
+#'  e.g. `shift=-1` renames `group2` to `group1`.
+#'
+#' @return an ARD data frame of class 'card'
+#' @name rename_ard_groups
+#'
+#' @examples
+#' ard <- ard_continuous(ADSL, by = c(SEX, ARM), variables = AGE)
+#'
+#' # Example 1 ----------------------------------
+#' rename_ard_groups_shift(ard, shift = -1)
+#'
+#' # Example 2 ----------------------------------
+#' rename_ard_groups_reverse(ard)
+NULL
+
+#' @rdname rename_ard_groups
+#' @export
+rename_ard_groups_shift <- function(x, shift = -1) {
+  # check inputs ---------------------------------------------------------------
+  set_cli_abort_call()
+  check_class(x, "card")
+  check_integerish(shift)
+
+  # create data frame with old names and new names -----------------------------
+  df_group_names <-
+    .group_names_as_df(x) |>
+    dplyr::mutate(
+      new_group_id = .data$old_group_id + as.integer(.env$shift),
+      new_group_name =
+        pmap(
+          list(.data$old_group_name, .data$old_group_id, .data$new_group_id),
+          \(old_group_name, old_group_id, new_group_id) {
+            str_replace(
+              old_group_name,
+              pattern = paste0("^group", old_group_id),
+              replacement = paste0("group", new_group_id)
+            )
+          }
+        ) |>
+          as.character()
+    )
+
+  # warn about bad names
+  if (any(df_group_names$new_group_id < 1L)) {
+    cli::cli_inform(c("There are now non-standard group column names:
+                    {.val {df_group_names$new_group_name[df_group_names$new_group_id < 1L]}}.",
+      "i" = "Is this the shift you had planned?"
+    ))
+  }
+
+  # rename columns and return ARD ----------------------------------------------
+  x |>
+    dplyr::rename(!!!deframe(df_group_names[c("new_group_name", "old_group_name")]))
+}
+
+#' @rdname rename_ard_groups
+#' @export
+rename_ard_groups_reverse <- function(x) {
+  # check inputs ---------------------------------------------------------------
+  set_cli_abort_call()
+  check_class(x, "card")
+
+  # if no groups, return ARD unaltered -----------------------------------------
+  if (dplyr::select(x, all_ard_groups()) |> names() |> is_empty()) {
+    return(x)
+  }
+
+  # create data frame with old names and new names -----------------------------
+  df_group_names <- .group_names_as_df(x)
+
+  all_obs_ids <- sort(unique(df_group_names$old_group_id))
+  df_group_names$new_group_id <-
+    dplyr::recode(
+      df_group_names$old_group_id,
+      !!!set_names(all_obs_ids, rev(all_obs_ids))
+    )
+  df_group_names$new_group_name <-
+    pmap(
+      list(df_group_names$old_group_name, df_group_names$old_group_id, df_group_names$new_group_id),
+      \(old_group_name, old_group_id, new_group_id) {
+        str_replace(
+          old_group_name,
+          pattern = paste0("^group", old_group_id),
+          replacement = paste0("group", new_group_id)
+        )
+      }
+    ) |>
+    as.character()
+
+  # rename columns and return ARD ----------------------------------------------
+  x |>
+    dplyr::rename(!!!deframe(df_group_names[c("new_group_name", "old_group_name")])) |>
+    tidy_ard_column_order()
+}
+
+.group_names_as_df <- function(x) {
+  dplyr::tibble(
+    old_group_name = dplyr::select(x, all_ard_groups()) |> names(),
+    old_group_id =
+      str_extract(.data$old_group_name, "^group[0-9]+") |>
+        str_remove("^group") |>
+        as.integer()
+  )
+}

cards.Rproj

@@ -1,4 +1,5 @@
 Version: 1.0
+ProjectId: 11aa741b-8d1b-4431-8528-e24313ebcf83
 
 RestoreWorkspace: No
 SaveWorkspace: No

tests/testthat/_snaps/rename_ard_groups.md

@@ -0,0 +1,35 @@
+# rename_ard_groups_shift()
+
+    Code
+      dplyr::select(rename_ard_groups_shift(ard_continuous(ADSL, variables = AGE, by = c(
+        SEX, ARM)), shift = 1L), all_ard_groups()) %>% 1L[]
+    Message
+      {cards} data frame: 1 x 4
+    Output
+        group2 group2_level group3 group3_level
+      1    SEX            F    ARM      Placebo
+
+# rename_ard_groups_shift() messaging
+
+    Code
+      dplyr::select(rename_ard_groups_shift(ard_continuous(ADSL, variables = AGE, by = c(
+        SEX, ARM)), shift = -1L), all_ard_groups()) %>% 1L[]
+    Message
+      There are now non-standard group column names: "group0" and "group0_level".
+      i Is this the shift you had planned?
+      {cards} data frame: 1 x 4
+    Output
+        group0 group0_level group1 group1_level
+      1    SEX            F    ARM      Placebo
+
+# rename_ard_groups_reverse()
+
+    Code
+      dplyr::select(rename_ard_groups_reverse(ard_continuous(ADSL, variables = AGE,
+        by = c(SEX, ARM))), all_ard_groups()) %>% 1L[]
+    Message
+      {cards} data frame: 1 x 4
+    Output
+        group1 group1_level group2 group2_level
+      1    ARM      Placebo    SEX            F
+

tests/testthat/test-rename_ard_groups.R

@@ -0,0 +1,42 @@
+test_that("rename_ard_groups_shift()", {
+  # no errors when no grouping variables
+  expect_equal(
+    ard_continuous(ADSL, variables = AGE) |>
+      rename_ard_groups_shift(),
+    ard_continuous(ADSL, variables = AGE)
+  )
+
+  # works under normal circumstances
+  expect_snapshot(
+    ard_continuous(ADSL, variables = AGE, by = c(SEX, ARM)) |>
+      rename_ard_groups_shift(shift = 1L) |>
+      dplyr::select(all_ard_groups()) %>%
+      `[`(1L, )
+  )
+})
+
+test_that("rename_ard_groups_shift() messaging", {
+  expect_snapshot(
+    ard_continuous(ADSL, variables = AGE, by = c(SEX, ARM)) |>
+      rename_ard_groups_shift(shift = -1L) |>
+      dplyr::select(all_ard_groups()) %>%
+      `[`(1L, )
+  )
+})
+
+test_that("rename_ard_groups_reverse()", {
+  # no errors when no grouping variables
+  expect_equal(
+    ard_continuous(ADSL, variables = AGE) |>
+      rename_ard_groups_reverse(),
+    ard_continuous(ADSL, variables = AGE)
+  )
+
+  # works under normal circumstances
+  expect_snapshot(
+    ard_continuous(ADSL, variables = AGE, by = c(SEX, ARM)) |>
+      rename_ard_groups_reverse() |>
+      dplyr::select(all_ard_groups()) %>%
+      `[`(1L, )
+  )
+})