From 2a6700f6826d326b8d55bb669b6910f4d3f12e56 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 14 Apr 2026 22:24:54 +0300 Subject: [PATCH 01/11] modified sort_ard function --- R/sort_ard_hierarchical.R | 30 +++++++++++++++++++++++++++--- man/sort_ard_hierarchical.Rd | 14 +++++++++++++- 2 files changed, 40 insertions(+), 4 deletions(-) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index e228bbbfd..d14004819 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -24,6 +24,9 @@ #' sums, otherwise `p` is used. If neither `n` nor `p` are present in `x` for the variable, an error will occur. #' #' Defaults to `everything() ~ "descending"`. +#' @param sort_col \cr +#' specify the name of the treatment column you want to sort by eg 'Placebo' or leave it blank +#' to sort by the sum across all treatment columns. #' #' @return an ARD data frame of class 'card' #' @seealso [filter_ard_hierarchical()] @@ -51,11 +54,20 @@ #' denominator = ADSL #' ) |> #' sort_ard_hierarchical(sort = list(AESOC ~ "alphanumeric", AEDECOD ~ "descending")) +#' +#' ard_stack_hierarchical_count( +#' ADAE, +#' variables = c(AESOC, AEDECOD), +#' by = TRTA, +#' denominator = ADSL +#' ) |> +#' sort_ard_hierarchical(sort_col = "Placebo") + NULL #' @rdname sort_ard_hierarchical #' @export -sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") { +sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_col = NULL) { set_cli_abort_call() # check and process inputs --------------------------------------------------------------------- @@ -156,7 +168,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") { # descending sort x_sort <- x_sort |> # calculate sums for each group at the current level, then get group indices - .append_hierarchy_sums(ard_args, cols, i) + .append_hierarchy_sums(ard_args, cols, i, sort_col) } else { # alphanumeric sort x_sort <- x_sort |> @@ -248,7 +260,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") { } # this function calculates and appends group sums/ordering for the current hierarchy level (across `by` variables) -.append_hierarchy_sums <- function(x, ard_args, cols, i) { +.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_col = sort_col) { cur_var <- names(cols)[i] # get current grouping variable next_var <- names(cols)[i + 1] # get next grouping variable @@ -275,6 +287,18 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") { sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums # calculate group sums + + # 4th April 2026 - introduced the ability to sort the ARD based on a particular treatment column + + if(!is.null(sort_col)){ + x = x |> + dplyr::mutate(stat = dplyr::case_when(stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level == sort_col ~ stat, + stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level != sort_col ~ list(0), + TRUE ~ stat)) + }else { + x = x + } + sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> dplyr::filter( diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 8ed6b18ee..3cca1d224 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -4,7 +4,7 @@ \alias{sort_ard_hierarchical} \title{Sort Stacked Hierarchical ARDs} \usage{ -sort_ard_hierarchical(x, sort = everything() ~ "descending") +sort_ard_hierarchical(x, sort = everything() ~ "descending", sort_col = NULL) } \arguments{ \item{x}{(\code{card})\cr @@ -27,6 +27,10 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i } Defaults to \code{everything() ~ "descending"}.} + +\item{sort_col}{\cr +specify the name of the treatment column you want to sort by eg 'Placebo' or leave it blank +to sort by the sum across all treatment columns.} } \value{ an ARD data frame of class 'card' @@ -62,6 +66,14 @@ ard_stack_hierarchical_count( denominator = ADSL ) |> sort_ard_hierarchical(sort = list(AESOC ~ "alphanumeric", AEDECOD ~ "descending")) + +ard_stack_hierarchical_count( + ADAE, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = ADSL +) |> + sort_ard_hierarchical(sort_col = "Placebo") \dontshow{\}) # examplesIf} } \seealso{ From 72bc6fb9eff854c1d91fd0d186ea3f7442baaa26 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 28 Apr 2026 06:36:15 +0300 Subject: [PATCH 02/11] rectified CMD check errors --- .Rhistory | 170 +++++++++++++++++++++++++++++++++++ R/sort_ard_hierarchical.R | 31 +++---- man/sort_ard_hierarchical.Rd | 6 +- 3 files changed, 189 insertions(+), 18 deletions(-) create mode 100644 .Rhistory diff --git a/.Rhistory b/.Rhistory new file mode 100644 index 000000000..7e7672f02 --- /dev/null +++ b/.Rhistory @@ -0,0 +1,170 @@ +Sys.getenv() +library(cards) +library(gtsummary) +ard <- ard_tabulate( +data = cards::ADAE, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL +) +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA +) +ard <- ard_tabulate( +data = cards::ADAE, +by = TRTA +variables = c(AESOC, AEDECOD), +ard <- ard_tabulate( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL +) +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA +) +ae_tbl +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA, +statistic = "{n} (p)}" +) +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA, +statistic = "{n} ({p})" +) +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA, +statistic = list(all_categorical() ~ "{n} ({p})") +) +ae_tbl +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA, +statistic = list(all_categorical() ~ "{n} ({p})") +) |> +sort_ard_hierarchical() +ard <- ard_tabulate( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL +) |> +sort_ard_hierarchical() +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +id = USUBJID +) |> +sort_ard_hierarchical() +ae_tbl <- tbl_ard_summary( +ard, +by = TRTA, +statistic = list(all_categorical() ~ "{n} ({p})") +) +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +statistic = list(all_categorical() ~ "{n} ({p})") +) +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +variables = c(AESOC, AEDECOD), +statistic = list(all_categorical() ~ "{n} ({p})") +) +ae_tbl +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +statistic = list(all_categorical() ~ "{n} ({p})"), +id = USUBJID +) |> +sort_ard_hierarchical() +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +variables = c(AESOC, AEDECOD), +statistic = list(all_categorical() ~ "{n} ({p})") +) +ae_tbl +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +id = USUBJID +) |> +sort_ard_hierarchical() +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +variables = c(AESOC, AEDECOD) +) +ae_tbl +devtools::load_all() +getwd() +setwd("D:/ARDs/cards") +getwd() +devtools::load_all() +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +statistic = list(all_categorical() ~ "{n} ({p})"), +id = USUBJID +) |> +sort_ard_hierarchical() +ADSL +table(ADSL$TRTA) +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +statistic = list(all_categorical() ~ "{n} ({p})"), +id = USUBJID +) |> +sort_ard_hierarchical(sort_col = Placebo) +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +statistic = list(all_categorical() ~ "{n} ({p})"), +id = USUBJID +) |> +sort_ard_hierarchical(sort_col = 'Placebo') +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +variables = c(AESOC, AEDECOD) +) +ae_tbl +ard <- ard_stack_hierarchical( +data = cards::ADAE, +by = TRTA, +variables = c(AESOC, AEDECOD), +denominator = cards::ADSL, +statistic = list(all_categorical() ~ "{n} ({p})"), +id = USUBJID +) |> +sort_ard_hierarchical(sort_col = 'Xanomeline High Dose') +ae_tbl <- tbl_ard_hierarchical( +ard, +by = TRTA, +variables = c(AESOC, AEDECOD) +) +ae_tbl +devtools::check() +devtools::install_dev_deps() +devtools::check() +devtools::test_coverage() diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index d14004819..cb3aecbcf 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -25,8 +25,8 @@ #' #' Defaults to `everything() ~ "descending"`. #' @param sort_col \cr -#' specify the name of the treatment column you want to sort by eg 'Placebo' or leave it blank -#' to sort by the sum across all treatment columns. +#' specify the name of the treatment column you want to sort by, or leave it blank to sort by the sum +#' across all treatment columns. #' #' @return an ARD data frame of class 'card' #' @seealso [filter_ard_hierarchical()] @@ -54,7 +54,7 @@ #' denominator = ADSL #' ) |> #' sort_ard_hierarchical(sort = list(AESOC ~ "alphanumeric", AEDECOD ~ "descending")) -#' +#' #' ard_stack_hierarchical_count( #' ADAE, #' variables = c(AESOC, AEDECOD), @@ -62,7 +62,6 @@ #' denominator = ADSL #' ) |> #' sort_ard_hierarchical(sort_col = "Placebo") - NULL #' @rdname sort_ard_hierarchical @@ -287,18 +286,20 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums # calculate group sums - - # 4th April 2026 - introduced the ability to sort the ARD based on a particular treatment column - - if(!is.null(sort_col)){ - x = x |> - dplyr::mutate(stat = dplyr::case_when(stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level == sort_col ~ stat, - stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level != sort_col ~ list(0), - TRUE ~ stat)) - }else { - x = x + + # Introduced the ability to sort the ARD based on a particular treatment column + + if (!is.null(sort_col)) { + x <- x |> + dplyr::mutate(stat = dplyr::case_when( + stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level == sort_col ~ stat, + stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level != sort_col ~ list(0), + TRUE ~ stat + )) + } else { + x <- x } - + sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> dplyr::filter( diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 3cca1d224..157ea3b48 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -29,8 +29,8 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i Defaults to \code{everything() ~ "descending"}.} \item{sort_col}{\cr -specify the name of the treatment column you want to sort by eg 'Placebo' or leave it blank -to sort by the sum across all treatment columns.} +specify the name of the treatment column you want to sort by, or leave it blank to sort by the sum +across all treatment columns.} } \value{ an ARD data frame of class 'card' @@ -66,7 +66,7 @@ ard_stack_hierarchical_count( denominator = ADSL ) |> sort_ard_hierarchical(sort = list(AESOC ~ "alphanumeric", AEDECOD ~ "descending")) - + ard_stack_hierarchical_count( ADAE, variables = c(AESOC, AEDECOD), From b31c8adf3afec141db18553c52c59cceb3bbd3cb Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 28 Apr 2026 20:52:34 +0300 Subject: [PATCH 03/11] rectified the R CMD error --- .Rhistory | 11 +++++++++++ .gitignore | 2 ++ R/sort_ard_hierarchical.R | 5 ++--- man/sort_ard_hierarchical.Rd | 5 ++--- 4 files changed, 17 insertions(+), 6 deletions(-) diff --git a/.Rhistory b/.Rhistory index 7e7672f02..610e2b761 100644 --- a/.Rhistory +++ b/.Rhistory @@ -168,3 +168,14 @@ devtools::check() devtools::install_dev_deps() devtools::check() devtools::test_coverage() +devtools::install_dev_deps() +devtools::check() +devtools::check() +styler::style_file("R/sort_ard_hierarchical.R") +styler::style_file("R/sort_ard_hierarchical.R") +spelling::update_wordlist() +install.packages('spelling') +spelling::update_wordlist() +spelling::update_wordlist() +spelling::update_wordlist() +devtools::check() diff --git a/.gitignore b/.gitignore index aae23eaae..2cf66bc9a 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,8 @@ .Rproj.user +.Rhistory docs .DS_Store tests/testthat/_snaps/**/*.new.md tests/testthat/_snaps/**/*.new.svg revdep + diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 5a978913f..9c469c623 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -24,9 +24,8 @@ #' sums, otherwise `p` is used. If neither `n` nor `p` are present in `x` for the variable, an error will occur. #' #' Defaults to `everything() ~ "descending"`. -#' @param sort_col \cr -#' specify the name of the treatment column you want to sort by, or leave it blank to sort by the sum -#' across all treatment columns. +#' @param sort_col (`character`)\cr +#' name of the treatment column you want to sort by e.g "Placebo"; leave it blank if you to sort by the sum across all treatment columns. #' #' @return an ARD data frame of class 'card' #' @seealso [filter_ard_hierarchical()] diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 157ea3b48..c09e6f15a 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -28,9 +28,8 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i Defaults to \code{everything() ~ "descending"}.} -\item{sort_col}{\cr -specify the name of the treatment column you want to sort by, or leave it blank to sort by the sum -across all treatment columns.} +\item{sort_col}{(\code{character})\cr +name of the treatment column you want to sort by e.g "Placebo"; leave it blank if you to sort by the sum across all treatment columns.} } \value{ an ARD data frame of class 'card' From b42a71735ea20625d322888bf466950246a5e980 Mon Sep 17 00:00:00 2001 From: melkiades Date: Tue, 28 Apr 2026 20:45:33 +0200 Subject: [PATCH 04/11] Addition: copying {gtsummary} .* lines for .gitignore --- .gitignore | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 2cf66bc9a..8964cc52b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,7 +1,9 @@ .Rproj.user .Rhistory -docs +.RData +.Ruserdata .DS_Store +docs tests/testthat/_snaps/**/*.new.md tests/testthat/_snaps/**/*.new.svg revdep From 20089c39d66eebee478eb59de0fb919ebbce92c0 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Thu, 7 May 2026 18:32:24 +0300 Subject: [PATCH 05/11] modified sort_ard_hierarchical and deleted .Rhistory --- .Rhistory | 181 ----------------------------------- R/sort_ard_hierarchical.R | 22 +---- man/sort_ard_hierarchical.Rd | 2 +- 3 files changed, 6 insertions(+), 199 deletions(-) delete mode 100644 .Rhistory diff --git a/.Rhistory b/.Rhistory deleted file mode 100644 index 610e2b761..000000000 --- a/.Rhistory +++ /dev/null @@ -1,181 +0,0 @@ -Sys.getenv() -library(cards) -library(gtsummary) -ard <- ard_tabulate( -data = cards::ADAE, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL -) -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA -) -ard <- ard_tabulate( -data = cards::ADAE, -by = TRTA -variables = c(AESOC, AEDECOD), -ard <- ard_tabulate( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL -) -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA -) -ae_tbl -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA, -statistic = "{n} (p)}" -) -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA, -statistic = "{n} ({p})" -) -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA, -statistic = list(all_categorical() ~ "{n} ({p})") -) -ae_tbl -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA, -statistic = list(all_categorical() ~ "{n} ({p})") -) |> -sort_ard_hierarchical() -ard <- ard_tabulate( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL -) |> -sort_ard_hierarchical() -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -id = USUBJID -) |> -sort_ard_hierarchical() -ae_tbl <- tbl_ard_summary( -ard, -by = TRTA, -statistic = list(all_categorical() ~ "{n} ({p})") -) -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -statistic = list(all_categorical() ~ "{n} ({p})") -) -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -variables = c(AESOC, AEDECOD), -statistic = list(all_categorical() ~ "{n} ({p})") -) -ae_tbl -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -statistic = list(all_categorical() ~ "{n} ({p})"), -id = USUBJID -) |> -sort_ard_hierarchical() -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -variables = c(AESOC, AEDECOD), -statistic = list(all_categorical() ~ "{n} ({p})") -) -ae_tbl -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -id = USUBJID -) |> -sort_ard_hierarchical() -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -variables = c(AESOC, AEDECOD) -) -ae_tbl -devtools::load_all() -getwd() -setwd("D:/ARDs/cards") -getwd() -devtools::load_all() -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -statistic = list(all_categorical() ~ "{n} ({p})"), -id = USUBJID -) |> -sort_ard_hierarchical() -ADSL -table(ADSL$TRTA) -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -statistic = list(all_categorical() ~ "{n} ({p})"), -id = USUBJID -) |> -sort_ard_hierarchical(sort_col = Placebo) -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -statistic = list(all_categorical() ~ "{n} ({p})"), -id = USUBJID -) |> -sort_ard_hierarchical(sort_col = 'Placebo') -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -variables = c(AESOC, AEDECOD) -) -ae_tbl -ard <- ard_stack_hierarchical( -data = cards::ADAE, -by = TRTA, -variables = c(AESOC, AEDECOD), -denominator = cards::ADSL, -statistic = list(all_categorical() ~ "{n} ({p})"), -id = USUBJID -) |> -sort_ard_hierarchical(sort_col = 'Xanomeline High Dose') -ae_tbl <- tbl_ard_hierarchical( -ard, -by = TRTA, -variables = c(AESOC, AEDECOD) -) -ae_tbl -devtools::check() -devtools::install_dev_deps() -devtools::check() -devtools::test_coverage() -devtools::install_dev_deps() -devtools::check() -devtools::check() -styler::style_file("R/sort_ard_hierarchical.R") -styler::style_file("R/sort_ard_hierarchical.R") -spelling::update_wordlist() -install.packages('spelling') -spelling::update_wordlist() -spelling::update_wordlist() -spelling::update_wordlist() -devtools::check() diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 9c469c623..4ad80ad46 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -25,7 +25,7 @@ #' #' Defaults to `everything() ~ "descending"`. #' @param sort_col (`character`)\cr -#' name of the treatment column you want to sort by e.g "Placebo"; leave it blank if you to sort by the sum across all treatment columns. +#' name of the treatment column value you want to sort by e.g "Placebo"; leave it blank if you want to sort by the sum across all treatment columns. #' #' @return an ARD data frame of class 'card' #' @seealso [filter_ard_hierarchical()] @@ -69,6 +69,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co set_cli_abort_call() # check and process inputs --------------------------------------------------------------------- + check_string(sort_col, allow_empty = TRUE) check_not_missing(x) check_not_missing(sort) check_class(x, "card") @@ -166,7 +167,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co # descending sort x_sort <- x_sort |> # calculate sums for each group at the current level, then get group indices - .append_hierarchy_sums(ard_args, cols, i, sort_col) + .append_hierarchy_sums(ard_args, cols, i) } else { # alphanumeric sort x_sort <- x_sort |> @@ -258,7 +259,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co } # this function calculates and appends group sums/ordering for the current hierarchy level (across `by` variables) -.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_col = sort_col) { +.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_col = NULL) { cur_var <- names(cols)[i] # get current grouping variable next_var <- names(cols)[i + 1] # get next grouping variable @@ -285,24 +286,11 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums # calculate group sums - - # Introduced the ability to sort the ARD based on a particular treatment column - - if (!is.null(sort_col)) { - x <- x |> - dplyr::mutate(stat = dplyr::case_when( - stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level == sort_col ~ stat, - stat_name == sort_stat & variable == dplyr::last(ard_args$variables) & group1_level != sort_col ~ list(0), - TRUE ~ stat - )) - } else { - x <- x - } - sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> dplyr::filter( .data$stat_name == sort_stat, # select statistic to sum + if (!is.null(sort_col)) .data$group1_level == sort_col else TRUE, if (!is_empty(ard_args$by)) .data$group1 %in% ard_args$by else TRUE, if (length(c(ard_args$by, ard_args$variables)) > 1) { if (ard_args$variables[i] %in% ard_args$include & !cur_var %in% "variable") { diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index c09e6f15a..4f59c0f3b 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -29,7 +29,7 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i Defaults to \code{everything() ~ "descending"}.} \item{sort_col}{(\code{character})\cr -name of the treatment column you want to sort by e.g "Placebo"; leave it blank if you to sort by the sum across all treatment columns.} +name of the treatment column value you want to sort by e.g "Placebo"; leave it blank if you want to sort by the sum across all treatment columns.} } \value{ an ARD data frame of class 'card' From e7945faaf6712604a1020d0d5c3aa8fb8eebadd9 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Sat, 9 May 2026 11:21:20 +0300 Subject: [PATCH 06/11] addressed code review comments --- R/sort_ard_hierarchical.R | 27 +++-- man/sort_ard_hierarchical.Rd | 14 ++- tests/testthat/test-sort_ard_hierarchical.R | 125 ++++++++++++++++++++ 3 files changed, 154 insertions(+), 12 deletions(-) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 4ad80ad46..396bf891c 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -24,8 +24,10 @@ #' sums, otherwise `p` is used. If neither `n` nor `p` are present in `x` for the variable, an error will occur. #' #' Defaults to `everything() ~ "descending"`. -#' @param sort_col (`character`)\cr -#' name of the treatment column value you want to sort by e.g "Placebo"; leave it blank if you want to sort by the sum across all treatment columns. +#' @param sort_by_level (`character`)\cr +#' name of the treatment column value level by which you want to sort, e.g.,"Placebo". Leave it blank if you want to sort by +#' the sum across all treatment column value levels. It is useful when at least one elements of the sort +#' list has been specified as `"descending"`; however, it has no effect when sorting is specified as `sort = everything() ~ "alphanumeric"`. #' #' @return an ARD data frame of class 'card' #' @seealso [filter_ard_hierarchical()] @@ -60,16 +62,16 @@ #' by = TRTA, #' denominator = ADSL #' ) |> -#' sort_ard_hierarchical(sort_col = "Placebo") +#' sort_ard_hierarchical(sort_by_level = "Placebo") NULL #' @rdname sort_ard_hierarchical #' @export -sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_col = NULL) { +sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by_level = NULL) { set_cli_abort_call() # check and process inputs --------------------------------------------------------------------- - check_string(sort_col, allow_empty = TRUE) + check_string(sort_by_level, allow_empty = TRUE) check_not_missing(x) check_not_missing(sort) check_class(x, "card") @@ -89,6 +91,14 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co ard_args <- attributes(x)$args + # check that the values for sort_by_level actually exists + + if(!is.null(sort_by_level)) { + valid_choices <- unlist(unique(x$group1_level)) + sort_by_level <- rlang::arg_match(sort_by_level, values = valid_choices) + } + + # for calculations by highest severity, innermost variable is extracted from `by` if (length(ard_args$by) > 1) { ard_args$variables <- c(ard_args$variables, dplyr::last(ard_args$by)) @@ -167,7 +177,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co # descending sort x_sort <- x_sort |> # calculate sums for each group at the current level, then get group indices - .append_hierarchy_sums(ard_args, cols, i) + .append_hierarchy_sums(ard_args, cols, i, sort_by_level = sort_by_level) } else { # alphanumeric sort x_sort <- x_sort |> @@ -259,7 +269,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co } # this function calculates and appends group sums/ordering for the current hierarchy level (across `by` variables) -.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_col = NULL) { +.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_by_level = NULL) { cur_var <- names(cols)[i] # get current grouping variable next_var <- names(cols)[i + 1] # get next grouping variable @@ -285,12 +295,13 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_co } sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums + # calculate group sums sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> dplyr::filter( .data$stat_name == sort_stat, # select statistic to sum - if (!is.null(sort_col)) .data$group1_level == sort_col else TRUE, + if (!is.null(sort_by_level)) .data$group1_level == sort_by_level else TRUE, if (!is_empty(ard_args$by)) .data$group1 %in% ard_args$by else TRUE, if (length(c(ard_args$by, ard_args$variables)) > 1) { if (ard_args$variables[i] %in% ard_args$include & !cur_var %in% "variable") { diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 4f59c0f3b..2a31afbed 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -4,7 +4,11 @@ \alias{sort_ard_hierarchical} \title{Sort Stacked Hierarchical ARDs} \usage{ -sort_ard_hierarchical(x, sort = everything() ~ "descending", sort_col = NULL) +sort_ard_hierarchical( + x, + sort = everything() ~ "descending", + sort_by_level = NULL +) } \arguments{ \item{x}{(\code{card})\cr @@ -28,8 +32,10 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i Defaults to \code{everything() ~ "descending"}.} -\item{sort_col}{(\code{character})\cr -name of the treatment column value you want to sort by e.g "Placebo"; leave it blank if you want to sort by the sum across all treatment columns.} +\item{sort_by_level}{(\code{character})\cr +name of the treatment column value level by which you want to sort, e.g.,"Placebo". Leave it blank if you want to sort by +the sum across all treatment column value levels. It is useful when at least one elements of the sort +list has been specified as \code{"descending"}; however, it has no effect when sorting is specified as \code{sort = everything() ~ "alphanumeric"}.} } \value{ an ARD data frame of class 'card' @@ -72,7 +78,7 @@ ard_stack_hierarchical_count( by = TRTA, denominator = ADSL ) |> - sort_ard_hierarchical(sort_col = "Placebo") + sort_ard_hierarchical(sort_by_level = "Placebo") \dontshow{\}) # examplesIf} } \seealso{ diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index 906c046a6..3c6dbc15d 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -12,6 +12,17 @@ ard <- ard_stack_hierarchical( over_variables = TRUE ) +ADAE_subset2 <- cards::ADAE |> + dplyr::filter(AEDECOD %in% unique(cards::ADAE$AEDECOD)[1:20]) + +ard_2 <- ard_stack_hierarchical( + data = ADAE_subset2, + variables = c(AESOC, AEDECOD), + by = TRTA, + denominator = cards::ADSL, + id = USUBJID +) + test_that("sort_ard_hierarchical() works", { withr::local_options(width = 200) @@ -92,6 +103,104 @@ test_that("sort_ard_hierarchical(sort = 'descending') works", { ) }) + +test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), sort_by_level = 'Placebo') works", { + + + expect_silent(ard_2 <- sort_ard_hierarchical(ard_2, sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), + sort_by_level = "Placebo")) + + expect_equal( + ard_2 |> + dplyr::filter(group1 == "TRTA", group1_level == "Placebo", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::select(variable_level, stat) |> + dplyr::distinct(variable_level, .keep_all = TRUE) |> + dplyr::arrange(desc(as.numeric(stat))) |> + dplyr::pull(variable_level) |> + unlist(), + c( + "APPLICATION SITE PRURITUS", + "APPLICATION SITE DERMATITIS", + "APPLICATION SITE ERYTHEMA", + "APPLICATION SITE IRRITATION", + "APPLICATION SITE VESICLES", + "FATIGUE" + ) + ) + + expect_equal( + ard_2 |> + dplyr::filter(group1 == "TRTA", group1_level == "Xanomeline Low Dose", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::select(variable_level, stat) |> + dplyr::distinct(variable_level, .keep_all = TRUE) |> + dplyr::arrange(desc(as.numeric(stat))) |> + dplyr::pull(variable_level) |> + unlist(), + c( + "APPLICATION SITE PRURITUS", + "APPLICATION SITE ERYTHEMA", + "APPLICATION SITE DERMATITIS", + "APPLICATION SITE IRRITATION", + "FATIGUE", + "APPLICATION SITE VESICLES" + ) + ) + + expect_equal( + ard_2 |> + dplyr::filter(group1 == "TRTA", group1_level == "Xanomeline High Dose", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::select(variable_level, stat) |> + dplyr::distinct(variable_level, .keep_all = TRUE) |> + dplyr::arrange(desc(as.numeric(stat))) |> + dplyr::pull(variable_level) |> + unlist(), + c( + "APPLICATION SITE PRURITUS", + "APPLICATION SITE ERYTHEMA", + "APPLICATION SITE IRRITATION", + "APPLICATION SITE DERMATITIS", + "APPLICATION SITE VESICLES", + "FATIGUE" + ) + ) +}) + + + +test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_by_level = 'Placebo') works", { + + ard_3 <- ard_stack_hierarchical( + data = cards::ADAE |> dplyr::filter(AEDECOD %in% unique(cards::ADAE$AEDECOD)[1:5]), + variables = AEDECOD, + by = TRTA, + denominator = cards::ADSL, + id = USUBJID + ) + + expect_silent(ard_3 <- sort_ard_hierarchical(ard_3, sort = AEDECOD ~ 'descending', sort_by_level = "Placebo")) + + expect_equal( + ard_3 |> + dplyr::filter(group1 == "TRTA", group1_level == "Placebo", stat_name == "n") |> + dplyr::select(variable_level, stat) |> + dplyr::distinct(variable_level, .keep_all = TRUE) |> + dplyr::arrange(desc(as.numeric(stat))) |> + dplyr::pull(variable_level) |> + unlist(), + c( + "DIARRHOEA", + "ERYTHEMA", + "APPLICATION SITE PRURITUS", + "APPLICATION SITE ERYTHEMA", + "ATRIOVENTRICULAR BLOCK SECOND DEGREE" + ) + ) +}) + + test_that("sort_ard_hierarchical(sort = 'alphanumeric') works", { expect_silent(ard <- sort_ard_hierarchical(ard, sort = "alphanumeric")) @@ -451,4 +560,20 @@ test_that("sort_ard_hierarchical() error messaging works", { sort_ard_hierarchical(ard), error = TRUE ) + + #invalid sort_by_level input + + expect_snapshot( + sort_ard_hierarchical(ard2, sort_by_level = "Placebo1"), + error = TRUE + ) + + #sort_by_level should be a single character not a vector + expect_snapshot( + sort_ard_hierarchical(ard2, sort_by_level = c("Placebo","Xanomeline Low Dose")), + error = TRUE + ) + + }) + From 17f4778cef464abb87fafdd8e4068e2ee219e394 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Sat, 27 Jun 2026 11:24:25 +0300 Subject: [PATCH 07/11] renamed sort_by_level to sort_level, corrected failing tests. --- R/sort_ard_hierarchical.R | 20 ++++++++++---------- man/sort_ard_hierarchical.Rd | 10 +++------- tests/testthat/test-sort_ard_hierarchical.R | 16 ++++++++-------- 3 files changed, 21 insertions(+), 25 deletions(-) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 396bf891c..267653f9e 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -24,7 +24,7 @@ #' sums, otherwise `p` is used. If neither `n` nor `p` are present in `x` for the variable, an error will occur. #' #' Defaults to `everything() ~ "descending"`. -#' @param sort_by_level (`character`)\cr +#' @param sort_level (`character`)\cr #' name of the treatment column value level by which you want to sort, e.g.,"Placebo". Leave it blank if you want to sort by #' the sum across all treatment column value levels. It is useful when at least one elements of the sort #' list has been specified as `"descending"`; however, it has no effect when sorting is specified as `sort = everything() ~ "alphanumeric"`. @@ -62,16 +62,16 @@ #' by = TRTA, #' denominator = ADSL #' ) |> -#' sort_ard_hierarchical(sort_by_level = "Placebo") +#' sort_ard_hierarchical(sort_level = "Placebo") NULL #' @rdname sort_ard_hierarchical #' @export -sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by_level = NULL) { +sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_level = NULL) { set_cli_abort_call() # check and process inputs --------------------------------------------------------------------- - check_string(sort_by_level, allow_empty = TRUE) + check_string(sort_level, allow_empty = TRUE) check_not_missing(x) check_not_missing(sort) check_class(x, "card") @@ -91,11 +91,11 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by ard_args <- attributes(x)$args - # check that the values for sort_by_level actually exists + # check that the values for sort_level actually exists - if(!is.null(sort_by_level)) { + if(!is.null(sort_level)) { valid_choices <- unlist(unique(x$group1_level)) - sort_by_level <- rlang::arg_match(sort_by_level, values = valid_choices) + sort_level <- rlang::arg_match(sort_level, values = valid_choices) } @@ -177,7 +177,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by # descending sort x_sort <- x_sort |> # calculate sums for each group at the current level, then get group indices - .append_hierarchy_sums(ard_args, cols, i, sort_by_level = sort_by_level) + .append_hierarchy_sums(ard_args, cols, i, sort_level = sort_level) } else { # alphanumeric sort x_sort <- x_sort |> @@ -269,7 +269,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by } # this function calculates and appends group sums/ordering for the current hierarchy level (across `by` variables) -.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_by_level = NULL) { +.append_hierarchy_sums <- function(x, ard_args, cols, i, sort_level = NULL) { cur_var <- names(cols)[i] # get current grouping variable next_var <- names(cols)[i + 1] # get next grouping variable @@ -301,7 +301,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_by x_sums <- x |> dplyr::filter( .data$stat_name == sort_stat, # select statistic to sum - if (!is.null(sort_by_level)) .data$group1_level == sort_by_level else TRUE, + if (!is.null(sort_level)) .data$group1_level == sort_level else TRUE, if (!is_empty(ard_args$by)) .data$group1 %in% ard_args$by else TRUE, if (length(c(ard_args$by, ard_args$variables)) > 1) { if (ard_args$variables[i] %in% ard_args$include & !cur_var %in% "variable") { diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 2a31afbed..7ddb2de1c 100644 --- a/man/sort_ard_hierarchical.Rd +++ b/man/sort_ard_hierarchical.Rd @@ -4,11 +4,7 @@ \alias{sort_ard_hierarchical} \title{Sort Stacked Hierarchical ARDs} \usage{ -sort_ard_hierarchical( - x, - sort = everything() ~ "descending", - sort_by_level = NULL -) +sort_ard_hierarchical(x, sort = everything() ~ "descending", sort_level = NULL) } \arguments{ \item{x}{(\code{card})\cr @@ -32,7 +28,7 @@ sums, otherwise \code{p} is used. If neither \code{n} nor \code{p} are present i Defaults to \code{everything() ~ "descending"}.} -\item{sort_by_level}{(\code{character})\cr +\item{sort_level}{(\code{character})\cr name of the treatment column value level by which you want to sort, e.g.,"Placebo". Leave it blank if you want to sort by the sum across all treatment column value levels. It is useful when at least one elements of the sort list has been specified as \code{"descending"}; however, it has no effect when sorting is specified as \code{sort = everything() ~ "alphanumeric"}.} @@ -78,7 +74,7 @@ ard_stack_hierarchical_count( by = TRTA, denominator = ADSL ) |> - sort_ard_hierarchical(sort_by_level = "Placebo") + sort_ard_hierarchical(sort_level = "Placebo") \dontshow{\}) # examplesIf} } \seealso{ diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index 3c6dbc15d..bb2f1efe9 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -104,11 +104,11 @@ test_that("sort_ard_hierarchical(sort = 'descending') works", { }) -test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), sort_by_level = 'Placebo') works", { +test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), sort_level = 'Placebo') works", { expect_silent(ard_2 <- sort_ard_hierarchical(ard_2, sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), - sort_by_level = "Placebo")) + sort_level = "Placebo")) expect_equal( ard_2 |> @@ -170,7 +170,7 @@ test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ ' -test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_by_level = 'Placebo') works", { +test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_level = 'Placebo') works", { ard_3 <- ard_stack_hierarchical( data = cards::ADAE |> dplyr::filter(AEDECOD %in% unique(cards::ADAE$AEDECOD)[1:5]), @@ -180,7 +180,7 @@ test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_by_level = id = USUBJID ) - expect_silent(ard_3 <- sort_ard_hierarchical(ard_3, sort = AEDECOD ~ 'descending', sort_by_level = "Placebo")) + expect_silent(ard_3 <- sort_ard_hierarchical(ard_3, sort = AEDECOD ~ 'descending', sort_level = "Placebo")) expect_equal( ard_3 |> @@ -561,16 +561,16 @@ test_that("sort_ard_hierarchical() error messaging works", { error = TRUE ) - #invalid sort_by_level input + #invalid sort_level input expect_snapshot( - sort_ard_hierarchical(ard2, sort_by_level = "Placebo1"), + sort_ard_hierarchical(ard_2, sort_level = "Placebo1"), error = TRUE ) - #sort_by_level should be a single character not a vector + #sort_level should be a single character not a vector expect_snapshot( - sort_ard_hierarchical(ard2, sort_by_level = c("Placebo","Xanomeline Low Dose")), + sort_ard_hierarchical(ard_2, sort_level = c("Placebo","Xanomeline Low Dose")), error = TRUE ) From cd66cf4d112217d23b7aa4d438a6378c460d145a Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 30 Jun 2026 06:25:59 +0300 Subject: [PATCH 08/11] increased console width to 200 for the failing snapshot tests --- tests/testthat/_snaps/sort_ard_hierarchical.md | 17 +++++++++++++++++ tests/testthat/test-sort_ard_hierarchical.R | 2 ++ 2 files changed, 19 insertions(+) diff --git a/tests/testthat/_snaps/sort_ard_hierarchical.md b/tests/testthat/_snaps/sort_ard_hierarchical.md index 48190c7a9..88b4776df 100644 --- a/tests/testthat/_snaps/sort_ard_hierarchical.md +++ b/tests/testthat/_snaps/sort_ard_hierarchical.md @@ -85,3 +85,20 @@ Error in `sort_ard_hierarchical()`: ! If `sort='descending'` for any variables then either "n" or "p" must be present in `x` for each of these specified variables in order to calculate the count sums used for sorting. +--- + + Code + sort_ard_hierarchical(ard_2, sort_level = "Placebo1") + Condition + Error in `sort_ard_hierarchical()`: + ! `sort_level` must be one of "Placebo", "Xanomeline High Dose", or "Xanomeline Low Dose", not "Placebo1". + i Did you mean "Placebo"? + +--- + + Code + sort_ard_hierarchical(ard_2, sort_level = c("Placebo", "Xanomeline Low Dose")) + Condition + Error in `sort_ard_hierarchical()`: + ! The `sort_level` argument must be a string or empty, not a character vector. + diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index d7ba2e58c..7d4ec6d8d 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -530,6 +530,8 @@ test_that("sort_ard_hierarchical() works with overall data", { }) test_that("sort_ard_hierarchical() warning messaging works", { + withr::local_options(width = 200) + # invalid x input expect_snapshot( r <- sort_ard_hierarchical(ard_tabulate( From 23068f94c15fe35e3766c75818521db631b1d08c Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 30 Jun 2026 09:42:40 +0300 Subject: [PATCH 09/11] amended styling with styler::style_file() --- R/sort_ard_hierarchical.R | 2 +- tests/testthat/test-sort_ard_hierarchical.R | 39 +++++++++++---------- 2 files changed, 21 insertions(+), 20 deletions(-) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 55b526d61..c4a48995f 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -93,7 +93,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le # check that the values for sort_level actually exists - if(!is.null(sort_level)) { + if (!is.null(sort_level)) { valid_choices <- unlist(unique(x$group1_level)) sort_level <- rlang::arg_match(sort_level, values = valid_choices) } diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index 7d4ec6d8d..44cd5d667 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -105,15 +105,17 @@ test_that("sort_ard_hierarchical(sort = 'descending') works", { test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), sort_level = 'Placebo') works", { - - - expect_silent(ard_2 <- sort_ard_hierarchical(ard_2, sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ 'descending'), - sort_level = "Placebo")) + expect_silent(ard_2 <- sort_ard_hierarchical(ard_2, + sort = list(AESOC ~ "alphanumeric", AEDECOD ~ "descending"), + sort_level = "Placebo" + )) expect_equal( ard_2 |> - dplyr::filter(group1 == "TRTA", group1_level == "Placebo", - group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::filter( + group1 == "TRTA", group1_level == "Placebo", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n" + ) |> dplyr::select(variable_level, stat) |> dplyr::distinct(variable_level, .keep_all = TRUE) |> dplyr::arrange(desc(as.numeric(stat))) |> @@ -131,8 +133,10 @@ test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ ' expect_equal( ard_2 |> - dplyr::filter(group1 == "TRTA", group1_level == "Xanomeline Low Dose", - group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::filter( + group1 == "TRTA", group1_level == "Xanomeline Low Dose", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n" + ) |> dplyr::select(variable_level, stat) |> dplyr::distinct(variable_level, .keep_all = TRUE) |> dplyr::arrange(desc(as.numeric(stat))) |> @@ -150,8 +154,10 @@ test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ ' expect_equal( ard_2 |> - dplyr::filter(group1 == "TRTA", group1_level == "Xanomeline High Dose", - group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n") |> + dplyr::filter( + group1 == "TRTA", group1_level == "Xanomeline High Dose", + group2_level == "GENERAL DISORDERS AND ADMINISTRATION SITE CONDITIONS", stat_name == "n" + ) |> dplyr::select(variable_level, stat) |> dplyr::distinct(variable_level, .keep_all = TRUE) |> dplyr::arrange(desc(as.numeric(stat))) |> @@ -169,9 +175,7 @@ test_that("sort_ard_hierarchical(sort = list(AESOC ~ 'alphanumeric', AEDECOD ~ ' }) - test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_level = 'Placebo') works", { - ard_3 <- ard_stack_hierarchical( data = cards::ADAE |> dplyr::filter(AEDECOD %in% unique(cards::ADAE$AEDECOD)[1:5]), variables = AEDECOD, @@ -180,7 +184,7 @@ test_that("sort_ard_hierarchical(sort = AEDECOD ~ 'descending', sort_level = 'Pl id = USUBJID ) - expect_silent(ard_3 <- sort_ard_hierarchical(ard_3, sort = AEDECOD ~ 'descending', sort_level = "Placebo")) + expect_silent(ard_3 <- sort_ard_hierarchical(ard_3, sort = AEDECOD ~ "descending", sort_level = "Placebo")) expect_equal( ard_3 |> @@ -562,19 +566,16 @@ test_that("sort_ard_hierarchical() warning messaging works", { error = TRUE ) - #invalid sort_level input + # invalid sort_level input expect_snapshot( sort_ard_hierarchical(ard_2, sort_level = "Placebo1"), error = TRUE ) - #sort_level should be a single character not a vector + # sort_level should be a single character not a vector expect_snapshot( - sort_ard_hierarchical(ard_2, sort_level = c("Placebo","Xanomeline Low Dose")), + sort_ard_hierarchical(ard_2, sort_level = c("Placebo", "Xanomeline Low Dose")), error = TRUE ) - - }) - From 3a14de143a085461a51661e561e16daaf07cc644 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Sun, 5 Jul 2026 16:10:53 +0300 Subject: [PATCH 10/11] added two extra units tests for sort_level, sort_level should now error if by statement is missing and more than two variables are specified in the by variables. Updated the NEWS.md file in regards to the new argument added --- NEWS.md | 6 +++ R/sort_ard_hierarchical.R | 41 +++++++++++++++++---- tests/testthat/test-sort_ard_hierarchical.R | 35 +++++++++++++++++- 3 files changed, 73 insertions(+), 9 deletions(-) diff --git a/NEWS.md b/NEWS.md index e04bea4b7..5e1d42a57 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,6 +8,11 @@ * Fixed `get_ard_statistics()` to return `NULL` statistics unchanged instead of attempting to attach attributes to `NULL`, which errors as of R 4.5.0. +## New Features and Functions + +* Added a new argument `sort_level` to `sort_ard_hierarchical()` function to allow sorting based on the values of a particular treatment column useful for adverse event reporting in clinical reports. (#548, @rikoprogrammer) + + # cards 0.8.0 @@ -31,6 +36,7 @@ * Update in `ard_tabulate()` to account for change in `as.data.frame()` being released in R-Devel. (#554) + ## Bug Fixes * Fixed bug in `rename_ard_columns()` whereby factor variables were getting converted to integers and added parameter `fct_as_chr` as is used in `unlist_ard_columns()` (#542) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index c4a48995f..4b686188c 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -91,19 +91,15 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le ard_args <- attributes(x)$args - # check that the values for sort_level actually exists - - if (!is.null(sort_level)) { - valid_choices <- unlist(unique(x$group1_level)) - sort_level <- rlang::arg_match(sort_level, values = valid_choices) - } # for calculations by highest severity, innermost variable is extracted from `by` if (length(ard_args$by) > 1) { ard_args$variables <- c(ard_args$variables, dplyr::last(ard_args$by)) ard_args$include <- c(ard_args$include, dplyr::last(ard_args$by)) - ard_args$by <- ard_args$by[-length(ard_args$by)] + ard_args$original_by <- ard_args$by + ard_args$by <- ard_args$by[-length(ard_args$by)] + } # get and check sorting method(s) @@ -125,6 +121,33 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le ) by <- ard_args$by + + + # if sort_level is specified then we can't have missing by argument. + if(!is.null(sort_level) & is_empty(ard_args$by)){ + cli::cli_abort( + "If 'by' argument is missing then sort_level has no useful meaning, please specify 'by' argument if you want to use sort_level.", + call = get_cli_abort_call() + ) + } + + + # if there are two or more by variables then sort_level is no longer useful, therefore abort. + if(!is.null(sort_level) & !is_empty(ard_args$by) & length(ard_args$original_by) > 1){ + cli::cli_abort( + "sort_level is not useful with more than one by variables.", + call = get_cli_abort_call() + ) + } + + + # check that the values for sort_level actually exists in the data + if (!is.null(sort_level) & !is_empty(ard_args$by)) { + valid_choices <- unlist(unique(x$group1_level)) + sort_level <- rlang::arg_match(sort_level, values = valid_choices) + } + + cols <- ard_args$variables |> stats::setNames( @@ -133,6 +156,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le names() ) + # attributes and total n not sorted - appended to bottom of sorted ARD has_attr <- "attributes" %in% x$context | "total_n" %in% x$context if (has_attr) { @@ -296,12 +320,13 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums + # calculate group sums sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> dplyr::filter( .data$stat_name == sort_stat, # select statistic to sum - if (!is.null(sort_level)) .data$group1_level == sort_level else TRUE, + if (!is.null(sort_level) & !is_empty(ard_args$by)) .data$group1_level == sort_level else TRUE, if (!is_empty(ard_args$by)) .data$group1 %in% ard_args$by else TRUE, if (length(c(ard_args$by, ard_args$variables)) > 1) { if (ard_args$variables[i] %in% ard_args$include & !cur_var %in% "variable") { diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index 44cd5d667..08fd7b4f5 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -567,7 +567,6 @@ test_that("sort_ard_hierarchical() warning messaging works", { ) # invalid sort_level input - expect_snapshot( sort_ard_hierarchical(ard_2, sort_level = "Placebo1"), error = TRUE @@ -578,4 +577,38 @@ test_that("sort_ard_hierarchical() warning messaging works", { sort_ard_hierarchical(ard_2, sort_level = c("Placebo", "Xanomeline Low Dose")), error = TRUE ) + + # no by variable specified - this should error. + + ard_no_by <- ard_stack_hierarchical( + data = ADAE_subset, + variables = c(SEX, RACE, AETERM), + denominator = cards::ADSL, + id = USUBJID, + statistic = everything() ~ "N" + ) + + expect_snapshot( + sort_ard_hierarchical(ard_no_by, sort_level = "F"), + error = TRUE + ) + + + # if more than two variables in the by statement then sort_level has no useful meaning. + ard_by_more <- ard_stack_hierarchical( + data = ADAE_subset, + variables = c(AESOC, AEDECOD), + by = c(TRTA,SEX), + denominator = cards::ADSL, + id = USUBJID, + statistic = everything() ~ "N" + ) + + + expect_snapshot( + sort_ard_hierarchical(ard_by_more, sort_level = "Placebo"), + error = TRUE + ) + + }) From 1bd348e731efff1fbf9619fc4e0cce90311d3da4 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Mon, 6 Jul 2026 07:19:18 +0300 Subject: [PATCH 11/11] corrected failing tests --- R/sort_ard_hierarchical.R | 16 +++++++--------- tests/testthat/test-sort_ard_hierarchical.R | 4 +--- 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 4b686188c..3882070b9 100644 --- a/R/sort_ard_hierarchical.R +++ b/R/sort_ard_hierarchical.R @@ -92,14 +92,12 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le ard_args <- attributes(x)$args - # for calculations by highest severity, innermost variable is extracted from `by` if (length(ard_args$by) > 1) { ard_args$variables <- c(ard_args$variables, dplyr::last(ard_args$by)) ard_args$include <- c(ard_args$include, dplyr::last(ard_args$by)) ard_args$original_by <- ard_args$by - ard_args$by <- ard_args$by[-length(ard_args$by)] - + ard_args$by <- ard_args$by[-length(ard_args$by)] } # get and check sorting method(s) @@ -124,19 +122,20 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le # if sort_level is specified then we can't have missing by argument. - if(!is.null(sort_level) & is_empty(ard_args$by)){ + if (!is.null(sort_level) & is_empty(ard_args$by)) { cli::cli_abort( - "If 'by' argument is missing then sort_level has no useful meaning, please specify 'by' argument if you want to use sort_level.", + "If 'by' argument is missing then sort_level has no useful meaning, + please specify 'by' argument if you want to use sort_level.", call = get_cli_abort_call() ) } # if there are two or more by variables then sort_level is no longer useful, therefore abort. - if(!is.null(sort_level) & !is_empty(ard_args$by) & length(ard_args$original_by) > 1){ + if (!is.null(sort_level) & !is_empty(ard_args$by) & length(ard_args$original_by) > 1) { cli::cli_abort( - "sort_level is not useful with more than one by variables.", - call = get_cli_abort_call() + "The argument `sort_level` is not useful with more than one by variables.", + call = get_cli_abort_call() ) } @@ -320,7 +319,6 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_le sort_stat <- if (n_stat) "n" else "p" # statistic used to calculate group sums - # calculate group sums sum_i <- paste0("sum_group_", i) # sum column label x_sums <- x |> diff --git a/tests/testthat/test-sort_ard_hierarchical.R b/tests/testthat/test-sort_ard_hierarchical.R index 08fd7b4f5..bd36f4d54 100644 --- a/tests/testthat/test-sort_ard_hierarchical.R +++ b/tests/testthat/test-sort_ard_hierarchical.R @@ -598,7 +598,7 @@ test_that("sort_ard_hierarchical() warning messaging works", { ard_by_more <- ard_stack_hierarchical( data = ADAE_subset, variables = c(AESOC, AEDECOD), - by = c(TRTA,SEX), + by = c(TRTA, SEX), denominator = cards::ADSL, id = USUBJID, statistic = everything() ~ "N" @@ -609,6 +609,4 @@ test_that("sort_ard_hierarchical() warning messaging works", { sort_ard_hierarchical(ard_by_more, sort_level = "Placebo"), error = TRUE ) - - })