diff --git a/NEWS.md b/NEWS.md index 02cf85d654..d2f9a43fe1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ ### Enhancements * Added the `denom` parameter to `s_count_cumulative()`, `s_count_missed_doses()`, and `s_count_occurrences_by_grade()`. * Added `"N_row"` as an optional input to `denom` in `s_count_occurrences()`. +* Refactored `a_count_occurrences_by_grade()` to no longer use `make_afun()`. ### Bug Fixes * Fixed bug in `a_summary()` causing non-unique `row_name` values to occur when multiple statistics are selected for count variables. diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 87b173199a..d23001605d 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -235,10 +235,7 @@ s_count_occurrences_by_grade <- function(df, #' * `a_count_occurrences_by_grade()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @examples -#' # We need to ungroup `count_fraction` first so that the `rtables` formatting -#' # function `format_count_fraction()` can be applied correctly. -#' afun <- make_afun(a_count_occurrences_by_grade, .ungroup_stats = "count_fraction") -#' afun( +#' a_count_occurrences_by_grade( #' df, #' .N_col = 10L, #' .N_row = 10L, @@ -248,10 +245,62 @@ s_count_occurrences_by_grade <- function(df, #' ) #' #' @export -a_count_occurrences_by_grade <- make_afun( - s_count_occurrences_by_grade, - .formats = c("count_fraction" = format_count_fraction_fixed_dp) -) +a_count_occurrences_by_grade <- function(df, + labelstr = "", + id = "USUBJID", + grade_groups = list(), + remove_single = TRUE, + only_grade_groups = FALSE, + denom = c("N_col", "n", "N_row"), + .N_col, # nolint + .N_row, # nolint + .df_row, + .var = NULL, + .stats = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL, + na_str = default_na_str()) { + x_stats <- s_count_occurrences_by_grade( + df = df, .var = .var, .N_row = .N_row, .N_col = .N_col, id = id, + grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, + denom = denom, labelstr = labelstr + ) + + if (is.null(unlist(x_stats))) { + return(NULL) + } + x_lvls <- names(x_stats[[1]]) + + # Fill in with formatting defaults if needed + .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats) + if (length(.formats) == 1 && is.null(names(.formats))) { + .formats <- rep(.formats, length(.stats)) %>% setNames(.stats) + } + .formats <- get_formats_from_stats(.stats, .formats) + .labels <- get_labels_from_stats(.stats, .labels, row_nms = x_lvls) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = x_lvls) + + if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] + x_stats <- x_stats[.stats] + + # Ungroup statistics with values for each level of x + x_ungrp <- ungroup_stats(x_stats, .formats, .labels, list()) + x_stats <- x_ungrp[["x"]] + .formats <- x_ungrp[[".formats"]] + + # Auto format handling + .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) + + in_rows( + .list = x_stats, + .formats = .formats, + .names = unlist(.labels), + .labels = unlist(.labels), + .indent_mods = .indent_mods, + .format_na_strs = na_str + ) +} #' @describeIn count_occurrences_by_grade Layout-creating function which can take statistics function #' arguments and additional format arguments. This function is a wrapper for [rtables::analyze()]. @@ -321,40 +370,36 @@ count_occurrences_by_grade <- function(lyt, nested = TRUE, ..., table_names = var, - .stats = NULL, - .formats = NULL, + .stats = "count_fraction", + .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL) { checkmate::assert_flag(riskdiff) + extra_args <- list( + .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + ) s_args <- list( id = id, grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, ... ) - afun <- make_afun( - a_count_occurrences_by_grade, - .stats = .stats, - .formats = .formats, - .indent_mods = .indent_mods, - .ungroup_stats = "count_fraction" - ) - - extra_args <- if (isFALSE(riskdiff)) { - s_args + if (isFALSE(riskdiff)) { + extra_args <- c(extra_args, s_args) } else { - list( - afun = list("s_count_occurrences_by_grade" = afun), - .stats = .stats, - .indent_mods = .indent_mods, - s_args = s_args + extra_args <- c( + extra_args, + list( + afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade), + s_args = s_args + ) ) } analyze( lyt = lyt, vars = var, + afun = ifelse(isFALSE(riskdiff), a_count_occurrences_by_grade, afun_riskdiff), var_labels = var_labels, show_labels = show_labels, - afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), table_names = table_names, na_str = na_str, nested = nested, @@ -398,29 +443,37 @@ summarize_occurrences_by_grade <- function(lyt, grade_groups = list(), remove_single = TRUE, only_grade_groups = FALSE, + riskdiff = FALSE, na_str = default_na_str(), ..., - .stats = NULL, - .formats = NULL, + .stats = "count_fraction", + .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL) { + checkmate::assert_flag(riskdiff) extra_args <- list( + .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str + ) + s_args <- list( id = id, grade_groups = grade_groups, remove_single = remove_single, only_grade_groups = only_grade_groups, ... ) - cfun <- make_afun( - a_count_occurrences_by_grade, - .stats = .stats, - .formats = .formats, - .labels = .labels, - .indent_mods = .indent_mods, - .ungroup_stats = "count_fraction" - ) + if (isFALSE(riskdiff)) { + extra_args <- c(extra_args, s_args) + } else { + extra_args <- c( + extra_args, + list( + afun = list("s_count_occurrences_by_grade" = a_count_occurrences_by_grade), + s_args = s_args + ) + ) + } summarize_row_groups( lyt = lyt, var = var, - cfun = cfun, + cfun = ifelse(isFALSE(riskdiff), a_count_occurrences_by_grade, afun_riskdiff), na_str = na_str, extra_args = extra_args ) diff --git a/man/count_occurrences_by_grade.Rd b/man/count_occurrences_by_grade.Rd index 2bc09edd2e..5c6df5f444 100644 --- a/man/count_occurrences_by_grade.Rd +++ b/man/count_occurrences_by_grade.Rd @@ -21,8 +21,8 @@ count_occurrences_by_grade( nested = TRUE, ..., table_names = var, - .stats = NULL, - .formats = NULL, + .stats = "count_fraction", + .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL ) @@ -34,10 +34,11 @@ summarize_occurrences_by_grade( grade_groups = list(), remove_single = TRUE, only_grade_groups = FALSE, + riskdiff = FALSE, na_str = default_na_str(), ..., - .stats = NULL, - .formats = NULL, + .stats = "count_fraction", + .formats = list(count_fraction = format_count_fraction_fixed_dp), .indent_mods = NULL, .labels = NULL ) @@ -57,15 +58,21 @@ s_count_occurrences_by_grade( a_count_occurrences_by_grade( df, - .var, - .N_row, - .N_col, + labelstr = "", id = "USUBJID", grade_groups = list(), remove_single = TRUE, only_grade_groups = FALSE, denom = c("N_col", "n", "N_row"), - labelstr = "" + .N_col, + .N_row, + .df_row, + .var = NULL, + .stats = NULL, + .formats = NULL, + .labels = NULL, + .indent_mods = NULL, + na_str = default_na_str() ) } \arguments{ @@ -135,6 +142,8 @@ passed by \code{rtables}.} \item{labelstr}{(\code{string})\cr label of the level of the parent split currently being summarized (must be present as second argument in Content Row Functions). See \code{\link[rtables:summarize_row_groups]{rtables::summarize_row_groups()}} for more information.} + +\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} } \value{ \itemize{ @@ -262,10 +271,7 @@ s_count_occurrences_by_grade( grade_groups = list("ANY" = levels(df$AETOXGR)) ) -# We need to ungroup `count_fraction` first so that the `rtables` formatting -# function `format_count_fraction()` can be applied correctly. -afun <- make_afun(a_count_occurrences_by_grade, .ungroup_stats = "count_fraction") -afun( +a_count_occurrences_by_grade( df, .N_col = 10L, .N_row = 10L, diff --git a/man/try_car_anova.Rd b/man/try_car_anova.Rd index b3ba87bf83..a81cde8287 100644 --- a/man/try_car_anova.Rd +++ b/man/try_car_anova.Rd @@ -9,12 +9,12 @@ try_car_anova(mod, test.statistic) \arguments{ \item{mod}{\code{lm}, \code{aov}, \code{glm}, \code{multinom}, \code{polr} \code{mlm}, \code{coxph}, \code{coxme}, \code{lme}, \code{mer}, \code{merMod}, \code{svyglm}, \code{svycoxph}, - \code{rlm}, \code{clm}, \code{clmm}, or other suitable model object.} + \code{rlm}, or other suitable model object.} \item{test.statistic}{for a generalized linear model, whether to calculate \code{"LR"} (likelihood-ratio), \code{"Wald"}, or \code{"F"} tests; for a Cox or Cox mixed-effects model, whether to calculate \code{"LR"} (partial-likelihood ratio) or - \code{"Wald"} tests (with \code{"LR"} tests unavailable for Cox models using the \code{tt} argument); in the default case or for linear mixed models fit by + \code{"Wald"} tests; in the default case or for linear mixed models fit by \code{lmer}, whether to calculate Wald \code{"Chisq"} or Kenward-Roger \code{"F"} tests with Satterthwaite degrees of freedom (\emph{warning:} the KR F-tests can be very time-consuming). diff --git a/tests/testthat/_snaps/count_occurrences_by_grade.md b/tests/testthat/_snaps/count_occurrences_by_grade.md index a5270668b1..94cf945880 100644 --- a/tests/testthat/_snaps/count_occurrences_by_grade.md +++ b/tests/testthat/_snaps/count_occurrences_by_grade.md @@ -228,6 +228,39 @@ +# a_count_occurrences_by_grade works with healthy input. + + Code + res + Output + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 1 2 (20%) 0 1 + 2 2 2 (20%) 0 2 + 3 3 2 (20%) 0 3 + 4 4 0 0 4 + 5 5 0 0 5 + 6 1 2 (20.0%) 0 1 + 7 2 2 (20.0%) 0 2 + 8 3 2 (20.0%) 0 3 + 9 4 0 0 4 + 10 5 0 0 5 + +# a_count_occurrences_by_grade works with custom input. + + Code + res + Output + RowsVerticalSection (in_rows) object print method: + ---------------------------- + row_name formatted_cell indent_mod row_label + 1 Level: 1 2 (20%) 1 Level: 1 + 2 LVL 2 2 (20%) 2 LVL 2 + 3 Count of 3 2 (20%) 0 Count of 3 + 4 Missing 4 0 (0%) 3 Missing 4 + 5 5 0 (0%) 0 5 + # count_occurrences_by_grade works with default arguments for intensity Code @@ -416,3 +449,39 @@ MODERATE 1 (100%) 1 (50.0%) SEVERE 0 0 +# summarize_occurrences works as expected with risk difference column + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ———————————————————————————————————————————————————————————————————————————————————— + F + MILD 3 (1.5%) 4 (2.3%) 1 (0.6%) -0.8 (-3.5 - 2.0) + MODERATE 8 (4.0%) 6 (3.4%) 6 (3.7%) 0.6 (-3.2 - 4.4) + SEVERE 22 (10.9%) 21 (11.9%) 20 (12.3%) -1.0 (-7.4 - 5.4) + M + MILD 3 (1.5%) 0 1 (0.6%) 1.5 (-0.2 - 3.2) + MODERATE 11 (5.4%) 9 (5.1%) 8 (4.9%) 0.4 (-4.1 - 4.9) + SEVERE 12 (5.9%) 17 (9.6%) 12 (7.4%) -3.7 (-9.1 - 1.8) + +--- + + Code + res + Output + A: Drug X B: Placebo C: Combination Risk Difference (%) (95% CI) + (N=202) (N=177) (N=162) (N=379) + ————————————————————————————————————————————————————————————————————————————————————— + F + -Any- 20 (9.9%) 19 (10.7%) 19 (11.7%) -0.8 (-7.0 - 5.3) + MILD 2 (1.0%) 2 (1.1%) 0 -0.1 (-2.2 - 1.9) + MODERATE 4 (2.0%) 3 (1.7%) 3 (1.9%) 0.3 (-2.4 - 3.0) + SEVERE 14 (6.9%) 14 (7.9%) 16 (9.9%) -1.0 (-6.3 - 4.3) + M + -Any- 14 (6.9%) 21 (11.9%) 17 (10.5%) -4.9 (-10.8 - 1.0) + MILD 1 (0.5%) 0 1 (0.6%) 0.5 (-0.5 - 1.5) + MODERATE 4 (2.0%) 7 (4.0%) 5 (3.1%) -2.0 (-5.4 - 1.5) + SEVERE 9 (4.5%) 14 (7.9%) 11 (6.8%) -3.5 (-8.3 - 1.4) + diff --git a/tests/testthat/test-count_occurrences_by_grade.R b/tests/testthat/test-count_occurrences_by_grade.R index 64b842fed4..7f5b09bfdc 100644 --- a/tests/testthat/test-count_occurrences_by_grade.R +++ b/tests/testthat/test-count_occurrences_by_grade.R @@ -135,6 +135,34 @@ testthat::test_that("s_count_occurrences_by_grade works with valid input for int testthat::expect_snapshot(res) }) +testthat::test_that("a_count_occurrences_by_grade works with healthy input.", { + options("width" = 100) + + result <- a_count_occurrences_by_grade( + df = raw_data, .N_col = 10, .N_row = 10, .df_row = raw_data, + .stats = get_stats("count_occurrences_by_grade"), + .var = "AETOXGR", id = "USUBJID" + ) + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + +testthat::test_that("a_count_occurrences_by_grade works with custom input.", { + options("width" = 100) + + result <- a_count_occurrences_by_grade( + df = raw_data, .N_col = 10, .N_row = 10, .df_row = raw_data, + .stats = "count_fraction", + .formats = c(count_fraction = "xx (xx%)"), + .labels = list("1" = "Level: 1", "2" = "LVL 2", "count_fraction.3" = "Count of 3", "4" = "Missing 4"), + .indent_mods = list("1" = 1L, "2" = 2L, "count_fraction.4" = 3L), + .var = "AETOXGR", id = "USUBJID" + ) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + testthat::test_that("count_occurrences_by_grade works with default arguments for intensity", { df <- raw_data df_adsl <- unique(df[c("ARM", "ARM_EMPTY", "USUBJID")]) @@ -429,3 +457,38 @@ testthat::test_that("count_occurrences_by_grade works with denom argument specif res <- testthat::expect_silent(result[-c(2, 6)]) testthat::expect_snapshot(res) }) + +testthat::test_that("summarize_occurrences works as expected with risk difference column", { + tern_ex_adae$AESEV <- factor(tern_ex_adae$AESEV) + + # Default parameters + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + split_rows_by("SEX", child_labels = "visible") %>% + summarize_occurrences_by_grade( + var = "AESEV", + riskdiff = TRUE + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) + + # Grade groups, custom id var + grade_groups <- list("-Any-" = levels(tern_ex_adae$AESEV)) + + result <- basic_table(show_colcounts = TRUE) %>% + split_cols_by("ARM", split_fun = add_riskdiff("A: Drug X", "B: Placebo")) %>% + split_rows_by("SEX", child_labels = "visible") %>% + summarize_occurrences_by_grade( + var = "AESEV", + riskdiff = TRUE, + .indent_mods = 1L, + grade_groups = grade_groups, + id = "SITEID" + ) %>% + build_table(tern_ex_adae) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +})