From adda1d1c820a680dc21e0d5a97fa5ebfcceba2f5 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Wed, 15 Jan 2025 15:19:03 -0800 Subject: [PATCH 1/2] adding group rename functions --- NAMESPACE | 2 + R/rename_ard_groups.R | 112 +++++++++++++++++++++ cards.Rproj | 1 + man/rename_ard_groups.Rd | 35 +++++++ tests/testthat/_snaps/rename_ard_groups.md | 35 +++++++ tests/testthat/test-rename_ard_groups.R | 42 ++++++++ 6 files changed, 227 insertions(+) create mode 100644 R/rename_ard_groups.R create mode 100644 man/rename_ard_groups.Rd create mode 100644 tests/testthat/_snaps/rename_ard_groups.md create mode 100644 tests/testthat/test-rename_ard_groups.R diff --git a/NAMESPACE b/NAMESPACE index b3ab5ea1d..07f7e4a92 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/rename_ard_groups.R b/R/rename_ard_groups.R new file mode 100644 index 000000000..d8980863a --- /dev/null +++ b/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() + ) +} diff --git a/cards.Rproj b/cards.Rproj index 69fafd4b6..42611750b 100644 --- a/cards.Rproj +++ b/cards.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 11aa741b-8d1b-4431-8528-e24313ebcf83 RestoreWorkspace: No SaveWorkspace: No diff --git a/man/rename_ard_groups.Rd b/man/rename_ard_groups.Rd new file mode 100644 index 000000000..05f24e32f --- /dev/null +++ b/man/rename_ard_groups.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/rename_ard_groups.R +\name{rename_ard_groups} +\alias{rename_ard_groups} +\alias{rename_ard_groups_shift} +\alias{rename_ard_groups_reverse} +\title{Rename ARD Group Columns} +\usage{ +rename_ard_groups_shift(x, shift = -1) + +rename_ard_groups_reverse(x) +} +\arguments{ +\item{x}{(\code{data.frame})\cr +an ARD data frame of class 'card'.} + +\item{shift}{(\code{integer})\cr +an integer specifying how many values to shift the group IDs, +e.g. \code{shift=-1} renames \code{group2} to \code{group1}.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Functions for renaming group columns names in ARDs. +} +\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) +} diff --git a/tests/testthat/_snaps/rename_ard_groups.md b/tests/testthat/_snaps/rename_ard_groups.md new file mode 100644 index 000000000..09bf331ce --- /dev/null +++ b/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 + diff --git a/tests/testthat/test-rename_ard_groups.R b/tests/testthat/test-rename_ard_groups.R new file mode 100644 index 000000000..fbfb04dc4 --- /dev/null +++ b/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, ) + ) +}) From 991b4fdc591b5c0b070aa1872ddd56d52a29d774 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Wed, 15 Jan 2025 15:21:16 -0800 Subject: [PATCH 2/2] Update _pkgdown.yml --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index da17c611c..e49691075 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -64,6 +64,7 @@ reference: - as_nested_list - get_ard_statistics - replace_null_statistic + - rename_ard_groups - subtitle: "Table Shells" contents: - mock