From 2a6700f6826d326b8d55bb669b6910f4d3f12e56 Mon Sep 17 00:00:00 2001 From: rikoprogrammer Date: Tue, 14 Apr 2026 22:24:54 +0300 Subject: [PATCH 1/6] 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 2/6] 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 3/6] 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 4/6] 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 5/6] 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 6/6] 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 + ) + + }) +