modified sort_ard_hierarchical function

.gitignore

@@ -1,8 +1,11 @@
 .Rproj.user
-docs
+.Rhistory
+.RData
+.Ruserdata
 .DS_Store
+docs
 tests/testthat/_snaps/**/*.new.md
 tests/testthat/_snaps/**/*.new.svg
 revdep
-.Rhistory
 .positai
+

NEWS.md

@@ -8,6 +8,10 @@
 
 * 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
 
 ## New Features and Functions
@@ -30,6 +34,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)

R/sort_ard_hierarchical.R

@@ -24,6 +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_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()]
@@ -51,14 +55,23 @@
 #'   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_level = "Placebo")
 NULL
 
 #' @rdname sort_ard_hierarchical
 #' @export
-sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") {
+sort_ard_hierarchical <- function(x, sort = everything() ~ "descending", sort_level = NULL) {
   set_cli_abort_call()
 
   # check and process inputs ---------------------------------------------------------------------
+  check_string(sort_level, allow_empty = TRUE)
   check_not_missing(x)
   check_not_missing(sort)
   check_class(x, "card")
@@ -78,10 +91,12 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") {
 
   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)]
   }
 
@@ -104,6 +119,34 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") {
   )
 
   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(
+      "The argument `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(
@@ -112,6 +155,7 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") {
         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) {
@@ -156,7 +200,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_level = sort_level)
     } else {
       # alphanumeric sort
       x_sort <- x_sort |>
@@ -248,7 +292,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_level = NULL) {
   cur_var <- names(cols)[i] # get current grouping variable
   next_var <- names(cols)[i + 1] # get next grouping variable
 
@@ -274,11 +318,13 @@ 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
   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) & !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") {

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.
+

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,108 @@ 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_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_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_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"))
 
@@ -421,6 +534,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(
@@ -450,4 +565,48 @@ test_that("sort_ard_hierarchical() warning messaging works", {
     sort_ard_hierarchical(ard),
     error = TRUE
   )
+
+  # 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
+  expect_snapshot(
+    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
+  )
 })