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
+

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_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()]
@@ -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_by_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_by_level = NULL) {
   set_cli_abort_call()
 
   # check and process inputs ---------------------------------------------------------------------
+  check_string(sort_by_level, allow_empty = TRUE)
   check_not_missing(x)
   check_not_missing(sort)
   check_class(x, "card")
@@ -78,6 +91,14 @@ sort_ard_hierarchical <- function(x, sort = everything() ~ "descending") {
 
   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))
@@ -156,7 +177,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_by_level = sort_by_level)
     } else {
       # alphanumeric sort
       x_sort <- x_sort |>
@@ -248,7 +269,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_by_level = NULL) {
   cur_var <- names(cols)[i] # get current grouping variable
   next_var <- names(cols)[i + 1] # get next grouping variable
 
@@ -274,11 +295,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_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") {

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"))
 
@@ -450,4 +559,20 @@ test_that("sort_ard_hierarchical() warning 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
+  )
+
+
 })
+