diff --git a/.gitignore b/.gitignore index da9da5413..5f5a1443f 100644 --- a/.gitignore +++ b/.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 + diff --git a/R/sort_ard_hierarchical.R b/R/sort_ard_hierarchical.R index 8ebdc738b..b206c712c 100644 --- a/R/sort_ard_hierarchical.R +++ b/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") { diff --git a/man/sort_ard_hierarchical.Rd b/man/sort_ard_hierarchical.Rd index 8ed6b18ee..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_ard_hierarchical( + x, + sort = everything() ~ "descending", + sort_by_level = NULL +) } \arguments{ \item{x}{(\code{card})\cr @@ -27,6 +31,11 @@ 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 +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' @@ -62,6 +71,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_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 d94b3ca2e..6f2054072 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")) @@ -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 + ) + + }) +