From 8ea2946600225c01b87c92e3365d9918d3d612ad Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 22 Nov 2024 21:59:04 -0500 Subject: [PATCH 01/14] Add ard_event_rates --- NAMESPACE | 1 + R/ard_event_rates.R | 164 +++++++++++++++++++++++++++++++++++++++++ man/ard_event_rates.Rd | 94 +++++++++++++++++++++++ 3 files changed, 259 insertions(+) create mode 100644 R/ard_event_rates.R create mode 100644 man/ard_event_rates.Rd diff --git a/NAMESPACE b/NAMESPACE index 5129b999..a7b53597 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(ard_effectsize_hedges_g) export(ard_effectsize_paired_cohens_d) export(ard_effectsize_paired_hedges_g) export(ard_emmeans_mean_difference) +export(ard_event_rates) export(ard_missing) export(ard_regression) export(ard_regression_basic) diff --git a/R/ard_event_rates.R b/R/ard_event_rates.R new file mode 100644 index 00000000..1d62be0b --- /dev/null +++ b/R/ard_event_rates.R @@ -0,0 +1,164 @@ +#' ARD to Calculate Event Occurrence Rates by ID +#' +#' Function calculates event occurrences rates per unique ID. +#' Each variable in `variables` is evaluated independently and then results for all variables are stacked. +#' For non-ordered variables (`ordered = FALSE`), each level that occurs per unique ID will be counted once. +#' For ordered variables (`ordered = TRUE`), only the highest-ordered level will be counted for each unique ID. +#' +#' @inheritParams cards::ard_categorical +#' @inheritParams cards::ard_stack +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' The factor variables for which event rates (for each level) will be calculated. +#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' Argument used to subset `data` to identify rows in `data` to calculate event rates. +#' @param denominator (`data.frame`, `integer`)\cr +#' Used to define the denominator and enhance the output. +#' The argument is optional. If not specified, `data` will be used as `denominator`. +#' - the univariate tabulations of the `by` variables are calculated with `denominator` when a data frame is passed, +#' e.g. tabulation of the treatment assignment counts that may appear in the header of a table. +#' @param ordered (`logical`)\cr +#' Specifies whether factor variables specified by `variables` are ordered or not. If ordered, only the +#' highest-ordered level will be counted for each unique value of `id`. Otherwise, each level that occurs per unique +#' value of `id` will be counted once. +#' +#' @return an ARD data frame of class 'card' +#' @name ard_event_rates +#' +#' @examples +#' # Example 1 - Event Rates ------------------------------------ +#' ard_event_rates( +#' cards::ADAE, +#' variables = c(AEBODSYS, AESOC), +#' id = USUBJID, +#' by = TRTA, +#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) +#' ) +#' +#' # Example 2 - Event Rates by Highest Severity ---------------- +#' ard_event_rates( +#' cards::ADAE, +#' variables = AESEV, +#' id = USUBJID, +#' by = TRTA, +#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), +#' ordered = TRUE +#' ) +NULL + +#' @rdname ard_event_rates +#' @export +ard_event_rates <- function(data, + variables, + id, + by = dplyr::group_vars(data), + statistic = everything() ~ c("n", "p", "N"), + denominator = NULL, + fmt_fn = NULL, + stat_label = everything() ~ cards::default_stat_labels(), + ordered = sapply(data[variables], is.ordered), + ...) { + set_cli_abort_call() + + # check inputs --------------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_not_missing(id) + cards::process_selectors(data, variables = {{ variables }}, id = {{ id }}, by = {{ by }}) + data <- dplyr::ungroup(data) + + # denominator must a data frame, or integer + if (!is_empty(denominator) && !is.data.frame(denominator) && !is_integerish(denominator)) { + cli::cli_abort( + "The {.arg denominator} argument must be a {.cls data.frame} or an {.cls integer}, not {.obj_type_friendly {denominator}}.", + call = get_cli_abort_call() + ) + } + if (is_empty(denominator)) denominator <- data + + # check the id argument is not empty + if (is_empty(id)) { + cli::cli_abort("Argument {.arg id} cannot be empty.", call = get_cli_abort_call()) + } + + # return empty ARD if no variables selected ---------------------------------- + if (is_empty(variables)) { + return(dplyr::tibble() |> cards::as_card()) + } + check_logical(ordered) + + # drop missing values -------------------------------------------------------- + df_na_nan <- is.na(data[c(by, variables)]) | apply(data[c(by, variables)], MARGIN = 2, is.nan) + if (any(df_na_nan)) { + rows_with_na <- apply(df_na_nan, MARGIN = 1, any) + cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na)}} row{?s} from {.arg data} with + {.val {NA}} or {.val {NaN}} values in {.val {c(by, variables)}} column{?s}.")) + data <- data[!rows_with_na, ] + } + + # remove missing by variables from `denominator` + if (is.data.frame(denominator) && !is_empty(intersect(by, names(denominator)))) { + df_na_nan_denom <- + is.na(denominator[intersect(by, names(denominator))]) | + apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) + if (any(df_na_nan_denom)) { + rows_with_na_denom <- apply(df_na_nan_denom, MARGIN = 1, any) + cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na_denom)}} row{?s} from {.arg denominator} with + {.val {NA}} or {.val {NaN}} values in {.val {intersect(by, names(denominator))}} column{?s}.")) + denominator <- denominator[!rows_with_na_denom, ] + } + } + + # sort data ------------------------------------------------------------------ + data <- dplyr::arrange(data, dplyr::pick(all_of(c(id, by, variables)))) + + # print denom columns if not 100% clear which are used + if (!is_empty(id) && is.data.frame(denominator)) { + denom_cols <- intersect(by, names(denominator)) + if (!setequal(by, denom_cols)) { + msg <- + ifelse( + is_empty(denom_cols), + "Denominator set by number of rows in {.arg denominator} data frame.", + "Denominator set by {.val {denom_cols}} column{?s} in {.arg denominator} data frame." + ) + cli::cli_inform(c("i" = msg)) + } + } + + lst_results <- list() + for (var in variables) { + ord <- (is_named(ordered) && ordered[var]) || (!is_named(ordered) && ordered[which(variables == var)]) + if (ord) data[[var]] <- factor(data[[var]], ordered = TRUE) + + lst_results <- + lst_results |> + append( + ard_categorical( + data = data |> + dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator)), if (!ord) var))), + variables = all_of(var), + by = all_of(by), + statistic = statistic, + denominator = denominator, + fmt_fn = fmt_fn, + stat_label = stat_label + ) |> + list() + ) + + if (ord) { + lst_results[[length(lst_results)]] <- lst_results[[length(lst_results)]] |> + mutate(variable_level = as.list(as.character(unlist(variable_level)))) + } + } + + # combine results ------------------------------------------------------------ + result <- lst_results |> + dplyr::bind_rows() |> + dplyr::mutate(context = "event_rates") |> + cards::tidy_ard_column_order() |> + cards::tidy_ard_row_order() + + # return final result -------------------------------------------------------- + result +} diff --git a/man/ard_event_rates.Rd b/man/ard_event_rates.Rd new file mode 100644 index 00000000..269963e2 --- /dev/null +++ b/man/ard_event_rates.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_event_rates.R +\name{ard_event_rates} +\alias{ard_event_rates} +\title{ARD to Calculate Event Occurrence Rates by ID} +\usage{ +ard_event_rates( + data, + variables, + id, + by = dplyr::group_vars(data), + statistic = everything() ~ c("n", "p", "N"), + denominator = NULL, + fmt_fn = NULL, + stat_label = everything() ~ cards::default_stat_labels(), + ordered = sapply(data[variables], is.ordered), + ... +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +a data frame} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +The factor variables for which event rates (for each level) will be calculated.} + +\item{id}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +Argument used to subset \code{data} to identify rows in \code{data} to calculate event rates.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +columns to tabulate by in the series of ARD function calls. +Any rows with \code{NA} or \code{NaN} values are removed from all calculations.} + +\item{statistic}{(\code{\link[cards:syntax]{formula-list-selector}})\cr +a named list, a list of formulas, +or a single formula where the list element one or more of \code{c("n", "N", "p")} +(or the RHS of a formula).} + +\item{denominator}{(\code{data.frame}, \code{integer})\cr +Used to define the denominator and enhance the output. +The argument is optional. If not specified, \code{data} will be used as \code{denominator}. +\itemize{ +\item the univariate tabulations of the \code{by} variables are calculated with \code{denominator} when a data frame is passed, +e.g. tabulation of the treatment assignment counts that may appear in the header of a table. +}} + +\item{fmt_fn}{(\code{\link[cards:syntax]{formula-list-selector}})\cr +a named list, a list of formulas, +or a single formula where the list element is a named list of functions +(or the RHS of a formula), +e.g. \verb{list(mpg = list(mean = \\(x) round(x, digits = 2) |> as.character()))}.} + +\item{stat_label}{(\code{\link[cards:syntax]{formula-list-selector}})\cr +a named list, a list of formulas, or a single formula where +the list element is either a named list or a list of formulas defining the +statistic labels, e.g. \code{everything() ~ list(n = "n", p = "pct")} or +\code{everything() ~ list(n ~ "n", p ~ "pct")}.} + +\item{ordered}{(\code{logical})\cr +Specifies whether factor variables specified by \code{variables} are ordered or not. If ordered, only the +highest-ordered level will be counted for each unique value of \code{id}. Otherwise, each level that occurs per unique +value of \code{id} will be counted once.} + +\item{...}{Arguments passed to methods.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Function calculates event occurrences rates per unique ID. +Each variable in \code{variables} is evaluated independently and then results for all variables are stacked. +For non-ordered variables (\code{ordered = FALSE}), each level that occurs per unique ID will be counted once. +For ordered variables (\code{ordered = TRUE}), only the highest-ordered level will be counted for each unique ID. +} +\examples{ +# Example 1 - Event Rates ------------------------------------ +ard_event_rates( + cards::ADAE, + variables = c(AEBODSYS, AESOC), + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) +) + +# Example 2 - Event Rates by Highest Severity ---------------- +ard_event_rates( + cards::ADAE, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + ordered = TRUE +) +} From 83bc5845981c5936d2906bc17d33b4c0d6d8ef92 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 25 Nov 2024 16:24:43 -0500 Subject: [PATCH 02/14] Add tests --- tests/testthat/_snaps/ard_event_rates.md | 143 +++++++++++++++ tests/testthat/test-ard_event_rates.R | 211 +++++++++++++++++++++++ 2 files changed, 354 insertions(+) create mode 100644 tests/testthat/_snaps/ard_event_rates.md create mode 100644 tests/testthat/test-ard_event_rates.R diff --git a/tests/testthat/_snaps/ard_event_rates.md b/tests/testthat/_snaps/ard_event_rates.md new file mode 100644 index 00000000..02891ba5 --- /dev/null +++ b/tests/testthat/_snaps/ard_event_rates.md @@ -0,0 +1,143 @@ +# ard_event_rates() works with default settings + + Code + print(res, n = 20, columns = "all") + Message + {cards} data frame: 207 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESOC CARDIAC … event_ra… n n 13 0 + 2 TRTA Placebo AESOC CARDIAC … event_ra… N N 301 0 + 3 TRTA Placebo AESOC CARDIAC … event_ra… p % 0.043 + 4 TRTA Placebo AESOC CONGENIT… event_ra… n n 0 0 + 5 TRTA Placebo AESOC CONGENIT… event_ra… N N 301 0 + 6 TRTA Placebo AESOC CONGENIT… event_ra… p % 0 + 7 TRTA Placebo AESOC EAR AND … event_ra… n n 1 0 + 8 TRTA Placebo AESOC EAR AND … event_ra… N N 301 0 + 9 TRTA Placebo AESOC EAR AND … event_ra… p % 0.003 + 10 TRTA Placebo AESOC EYE DISO… event_ra… n n 4 0 + 11 TRTA Placebo AESOC EYE DISO… event_ra… N N 301 0 + 12 TRTA Placebo AESOC EYE DISO… event_ra… p % 0.013 + 13 TRTA Placebo AESOC GASTROIN… event_ra… n n 17 0 + 14 TRTA Placebo AESOC GASTROIN… event_ra… N N 301 0 + 15 TRTA Placebo AESOC GASTROIN… event_ra… p % 0.056 + 16 TRTA Placebo AESOC GENERAL … event_ra… n n 21 0 + 17 TRTA Placebo AESOC GENERAL … event_ra… N N 301 0 + 18 TRTA Placebo AESOC GENERAL … event_ra… p % 0.07 + 19 TRTA Placebo AESOC HEPATOBI… event_ra… n n 1 0 + 20 TRTA Placebo AESOC HEPATOBI… event_ra… N N 301 0 + Message + i 187 more rows + i Use `print(n = ...)` to see more rows + +--- + + Code + print(ard_event_rates(group_by(cards::ADAE, TRTA), variables = AESOC, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") + Message + {cards} data frame: 207 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESOC CARDIAC … event_ra… n n 13 0 + 2 TRTA Placebo AESOC CARDIAC … event_ra… N N 86 0 + 3 TRTA Placebo AESOC CARDIAC … event_ra… p % 0.151 + 4 TRTA Placebo AESOC CONGENIT… event_ra… n n 0 0 + 5 TRTA Placebo AESOC CONGENIT… event_ra… N N 86 0 + 6 TRTA Placebo AESOC CONGENIT… event_ra… p % 0 + 7 TRTA Placebo AESOC EAR AND … event_ra… n n 1 0 + 8 TRTA Placebo AESOC EAR AND … event_ra… N N 86 0 + 9 TRTA Placebo AESOC EAR AND … event_ra… p % 0.012 + 10 TRTA Placebo AESOC EYE DISO… event_ra… n n 4 0 + 11 TRTA Placebo AESOC EYE DISO… event_ra… N N 86 0 + 12 TRTA Placebo AESOC EYE DISO… event_ra… p % 0.047 + 13 TRTA Placebo AESOC GASTROIN… event_ra… n n 17 0 + 14 TRTA Placebo AESOC GASTROIN… event_ra… N N 86 0 + 15 TRTA Placebo AESOC GASTROIN… event_ra… p % 0.198 + 16 TRTA Placebo AESOC GENERAL … event_ra… n n 21 0 + 17 TRTA Placebo AESOC GENERAL … event_ra… N N 86 0 + 18 TRTA Placebo AESOC GENERAL … event_ra… p % 0.244 + 19 TRTA Placebo AESOC HEPATOBI… event_ra… n n 1 0 + 20 TRTA Placebo AESOC HEPATOBI… event_ra… N N 86 0 + Message + i 187 more rows + i Use `print(n = ...)` to see more rows + +# ard_event_rates(statistic) works + + Code + ard_event_rates(cards::ADAE, variables = SEX, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), statistic = ~"n") + Message + {cards} data frame: 6 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo SEX F n n 40 + 2 TRTA Placebo SEX M n n 29 + 3 TRTA Xanomeli… SEX F n n 37 + 4 TRTA Xanomeli… SEX M n n 42 + 5 TRTA Xanomeli… SEX F n n 44 + 6 TRTA Xanomeli… SEX M n n 33 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_event_rates(ordered) works + + Code + print(res, n = 20, columns = "all") + Message + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESEV MILD event_ra… n n 36 0 + 2 TRTA Placebo AESEV MILD event_ra… N N 86 0 + 3 TRTA Placebo AESEV MILD event_ra… p % 0.419 + 4 TRTA Placebo AESEV MODERATE event_ra… n n 26 0 + 5 TRTA Placebo AESEV MODERATE event_ra… N N 86 0 + 6 TRTA Placebo AESEV MODERATE event_ra… p % 0.302 + 7 TRTA Placebo AESEV SEVERE event_ra… n n 7 0 + 8 TRTA Placebo AESEV SEVERE event_ra… N N 86 0 + 9 TRTA Placebo AESEV SEVERE event_ra… p % 0.081 + 10 TRTA Xanomeli… AESEV MILD event_ra… n n 22 0 + 11 TRTA Xanomeli… AESEV MILD event_ra… N N 84 0 + 12 TRTA Xanomeli… AESEV MILD event_ra… p % 0.262 + 13 TRTA Xanomeli… AESEV MODERATE event_ra… n n 49 0 + 14 TRTA Xanomeli… AESEV MODERATE event_ra… N N 84 0 + 15 TRTA Xanomeli… AESEV MODERATE event_ra… p % 0.583 + 16 TRTA Xanomeli… AESEV SEVERE event_ra… n n 8 0 + 17 TRTA Xanomeli… AESEV SEVERE event_ra… N N 84 0 + 18 TRTA Xanomeli… AESEV SEVERE event_ra… p % 0.095 + 19 TRTA Xanomeli… AESEV MILD event_ra… n n 19 0 + 20 TRTA Xanomeli… AESEV MILD event_ra… N N 84 0 + Message + i 7 more rows + i Use `print(n = ...)` to see more rows + +# ard_event_rates() errors with incomplete factor columns + + Code + ard_event_rates(dplyr::mutate(cards::ADAE, AESOC = factor(AESOC, levels = character( + 0))), variables = AESOC, id = USUBJID, by = TRTA) + Message + * Removing 1191 rows from `data` with NA or NaN values in "TRTA" and "AESOC" columns. + Condition + Error in `ard_event_rates()`: + ! Factors with empty "levels" attribute are not allowed, which was identified in column "AESOC". + +--- + + Code + ard_event_rates(dplyr::mutate(cards::ADAE, SEX = factor(SEX, levels = c("F", + "M", NA), exclude = NULL)), variables = SEX, id = USUBJID, by = TRTA) + Condition + Error in `ard_event_rates()`: + ! Factors with NA levels are not allowed, which are present in column "SEX". + +# ard_event_rates() works without any variables + + Code + ard_event_rates(data = cards::ADAE, variables = starts_with("xxxx"), id = USUBJID, + by = c(TRTA, AESEV)) + Message + {cards} data frame: 0 x 0 + Output + data frame with 0 columns and 0 rows + diff --git a/tests/testthat/test-ard_event_rates.R b/tests/testthat/test-ard_event_rates.R new file mode 100644 index 00000000..42145395 --- /dev/null +++ b/tests/testthat/test-ard_event_rates.R @@ -0,0 +1,211 @@ +test_that("ard_event_rates() works with default settings", { + withr::local_options(list(width = 200)) + + expect_silent( + res <- ard_event_rates( + cards::ADAE, + variables = AESOC, + id = USUBJID, + by = TRTA + ) + ) + expect_snapshot(res |> print(n = 20, columns = "all")) + + expect_equal( + res |> + dplyr::filter( + group1_level == "Placebo", + variable_level == "CARDIAC DISORDERS", + stat_name == "n" + ) |> + get_ard_statistics(), + list( + n = cards::ADAE |> + dplyr::filter( + TRTA == "Placebo", + AESOC == "CARDIAC DISORDERS" + ) |> + dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA", "AESOC"))) |> + nrow() + ) + ) + + # with denominator + expect_snapshot( + ard_event_rates( + cards::ADAE |> group_by(TRTA), + variables = AESOC, + id = USUBJID, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + ) |> + print(n = 20, columns = "all") + ) + + # with multiple variables + expect_silent( + res2 <- ard_event_rates( + cards::ADAE, + variables = c(SEX, AESOC), + id = USUBJID, + by = TRTA + ) + ) + expect_equal(unique(res2$variable), c("SEX", "AESOC")) + expect_equal( + res, + res2[-c(1:18), ] + ) +}) + +test_that("ard_event_rates(statistic) works", { + withr::local_options(list(width = 200)) + + expect_snapshot( + ard_event_rates( + cards::ADAE, + variables = SEX, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + statistic = ~"n" + ) + ) +}) + +test_that("ard_event_rates(ordered) works", { + withr::local_options(list(width = 200)) + + # pre-ordered factor variable + adae <- cards::ADAE |> + mutate(AESEV = factor(cards::ADAE$AESEV, ordered = TRUE)) + + expect_silent( + res <- ard_event_rates( + cards::ADAE, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + ordered = TRUE + ) + ) + expect_snapshot(res |> print(n = 20, columns = "all")) + + expect_equal( + res |> + dplyr::filter( + group1_level == "Placebo", + variable_level == "MODERATE", + stat_name == "n" + ) |> + get_ard_statistics(), + list( + n = adae |> + dplyr::arrange(AESEV) |> + dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA"))) |> + dplyr::filter( + TRTA == "Placebo", + AESEV == "MODERATE" + ) |> + nrow() + ) + ) + + res_unord <- ard_event_rates( + cards::ADAE, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + ) + expect_true(res$stat[[1]] != res_unord$stat[[1]]) + + res2 <- ard_event_rates( + adae, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + ) + expect_equal(res, res2) +}) + +test_that("ard_event_rates() errors with incomplete factor columns", { + # Check error when factors have no levels + expect_snapshot( + error = TRUE, + ard_event_rates( + cards::ADAE |> + dplyr::mutate(AESOC = factor(AESOC, levels = character(0))), + variables = AESOC, + id = USUBJID, + by = TRTA + ) + ) + + # Check error when factor has NA level + expect_snapshot( + error = TRUE, + ard_event_rates( + cards::ADAE |> + dplyr::mutate(SEX = factor(SEX, levels = c("F", "M", NA), exclude = NULL)), + variables = SEX, + id = USUBJID, + by = TRTA + ) + ) +}) + +test_that("ard_hierarchical_count() works with by variable not present in 'denominator'", { + expect_silent( + ard_events_with_by <- ard_event_rates( + data = cards::ADAE, + variables = AESOC, + id = USUBJID, + by = c(TRTA, AESEV), + statistic = ~"n" + ) + ) + + expect_equal( + ard_events_with_by |> + dplyr::filter( + group1_level == "Placebo", + group2_level == "MILD", + variable_level == "CARDIAC DISORDERS" + ) |> + get_ard_statistics(), + list( + n = cards::ADAE |> + dplyr::filter( + TRTA == "Placebo", + AESEV == "MILD", + AESOC == "CARDIAC DISORDERS" + ) |> + dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA", "AESEV", "AESOC"))) |> + nrow() + ) + ) +}) + +test_that("ard_event_rates() works without any variables", { + expect_snapshot( + ard_event_rates( + data = cards::ADAE, + variables = starts_with("xxxx"), + id = USUBJID, + by = c(TRTA, AESEV) + ) + ) +}) + +test_that("ard_event_rates() follows ard structure", { + expect_silent( + ard_event_rates( + cards::ADAE, + variables = AESOC, + id = USUBJID + ) |> + cards::check_ard_structure(method = FALSE) + ) +}) From 783b3ed836ef081b5d65bdc4176088e20aec2fcf Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 25 Nov 2024 18:21:38 -0500 Subject: [PATCH 03/14] Add check --- R/ard_event_rates.R | 11 ++++++++++- man/ard_event_rates.Rd | 3 ++- 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/ard_event_rates.R b/R/ard_event_rates.R index 1d62be0b..1d4dab81 100644 --- a/R/ard_event_rates.R +++ b/R/ard_event_rates.R @@ -19,7 +19,8 @@ #' @param ordered (`logical`)\cr #' Specifies whether factor variables specified by `variables` are ordered or not. If ordered, only the #' highest-ordered level will be counted for each unique value of `id`. Otherwise, each level that occurs per unique -#' value of `id` will be counted once. +#' value of `id` will be counted once. Must be the same length as `variables`. Defaults to `TRUE` for ordered factor +#' variables and `FALSE` otherwise. #' #' @return an ARD data frame of class 'card' #' @name ard_event_rates @@ -84,7 +85,15 @@ ard_event_rates <- function(data, if (is_empty(variables)) { return(dplyr::tibble() |> cards::as_card()) } + + # check the ordered argument check_logical(ordered) + if (length(ordered) != length(variables)) { + cli::cli_abort( + "Argument {.arg ordered} has length {length(ordered)} but must be the same length as {.arg variables} ({length(variables)}).", + call = get_cli_abort_call() + ) + } # drop missing values -------------------------------------------------------- df_na_nan <- is.na(data[c(by, variables)]) | apply(data[c(by, variables)], MARGIN = 2, is.nan) diff --git a/man/ard_event_rates.Rd b/man/ard_event_rates.Rd index 269963e2..ba3a3a6f 100644 --- a/man/ard_event_rates.Rd +++ b/man/ard_event_rates.Rd @@ -59,7 +59,8 @@ statistic labels, e.g. \code{everything() ~ list(n = "n", p = "pct")} or \item{ordered}{(\code{logical})\cr Specifies whether factor variables specified by \code{variables} are ordered or not. If ordered, only the highest-ordered level will be counted for each unique value of \code{id}. Otherwise, each level that occurs per unique -value of \code{id} will be counted once.} +value of \code{id} will be counted once. Must be the same length as \code{variables}. Defaults to \code{TRUE} for ordered factor +variables and \code{FALSE} otherwise.} \item{...}{Arguments passed to methods.} } From a717455dcdf1e3c46ada243c80e35ffc1f9dff78 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 25 Nov 2024 18:26:33 -0500 Subject: [PATCH 04/14] Add tests --- tests/testthat/_snaps/ard_event_rates.md | 8 +++++ tests/testthat/test-ard_event_rates.R | 40 ++++++++++++++++++++++++ 2 files changed, 48 insertions(+) diff --git a/tests/testthat/_snaps/ard_event_rates.md b/tests/testthat/_snaps/ard_event_rates.md index 02891ba5..46409589 100644 --- a/tests/testthat/_snaps/ard_event_rates.md +++ b/tests/testthat/_snaps/ard_event_rates.md @@ -111,6 +111,14 @@ i 7 more rows i Use `print(n = ...)` to see more rows +--- + + Code + ard_event_rates(adae, variables = c(SEX, AESEV), id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), ordered = TRUE) + Condition + Error in `ard_event_rates()`: + ! Argument `ordered` has length 1 but must be the same length as `variables` (2). + # ard_event_rates() errors with incomplete factor columns Code diff --git a/tests/testthat/test-ard_event_rates.R b/tests/testthat/test-ard_event_rates.R index 42145395..babf9a9b 100644 --- a/tests/testthat/test-ard_event_rates.R +++ b/tests/testthat/test-ard_event_rates.R @@ -128,6 +128,46 @@ test_that("ard_event_rates(ordered) works", { denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) expect_equal(res, res2) + + # multiple variables + expect_silent( + res3 <- ard_event_rates( + adae, + variables = c(SEX, AESEV), + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + ordered = c(FALSE, TRUE) + ) + ) + expect_equal(res, res3[-c(1:18), ]) + + # named vector + expect_silent( + res4 <- ard_event_rates( + adae, + variables = c(SEX, AESEV), + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + ordered = c(AESEV = TRUE, SEX = FALSE) + ) + ) + expect_equal(res3, res4) + + # error - length does not match + expect_snapshot( + ard_event_rates( + adae, + variables = c(SEX, AESEV), + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + ordered = TRUE + ), + error = TRUE + ) + expect_equal(res, res2) }) test_that("ard_event_rates() errors with incomplete factor columns", { From c1803f2ab654fb3d74f3db8459a8d9f18f99a5bb Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 25 Nov 2024 18:36:27 -0500 Subject: [PATCH 05/14] Fix check --- R/ard_event_rates.R | 2 +- _pkgdown.yml | 1 + tests/testthat/test-ard_event_rates.R | 6 +++--- 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/R/ard_event_rates.R b/R/ard_event_rates.R index 1d4dab81..a2384871 100644 --- a/R/ard_event_rates.R +++ b/R/ard_event_rates.R @@ -157,7 +157,7 @@ ard_event_rates <- function(data, if (ord) { lst_results[[length(lst_results)]] <- lst_results[[length(lst_results)]] |> - mutate(variable_level = as.list(as.character(unlist(variable_level)))) + dplyr::mutate(variable_level = as.list(as.character(unlist(.data$variable_level)))) } } diff --git a/_pkgdown.yml b/_pkgdown.yml index c129d233..e1cfcec2 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -88,6 +88,7 @@ reference: - ard_categorical_ci.data.frame - ard_regression - ard_regression_basic + - ard_event_rates - title: "Helpers" - contents: diff --git a/tests/testthat/test-ard_event_rates.R b/tests/testthat/test-ard_event_rates.R index babf9a9b..68e5a93a 100644 --- a/tests/testthat/test-ard_event_rates.R +++ b/tests/testthat/test-ard_event_rates.R @@ -18,7 +18,7 @@ test_that("ard_event_rates() works with default settings", { variable_level == "CARDIAC DISORDERS", stat_name == "n" ) |> - get_ard_statistics(), + cards::get_ard_statistics(), list( n = cards::ADAE |> dplyr::filter( @@ -98,7 +98,7 @@ test_that("ard_event_rates(ordered) works", { variable_level == "MODERATE", stat_name == "n" ) |> - get_ard_statistics(), + cards::get_ard_statistics(), list( n = adae |> dplyr::arrange(AESEV) |> @@ -214,7 +214,7 @@ test_that("ard_hierarchical_count() works with by variable not present in 'denom group2_level == "MILD", variable_level == "CARDIAC DISORDERS" ) |> - get_ard_statistics(), + cards::get_ard_statistics(), list( n = cards::ADAE |> dplyr::filter( From c023a1adf95b12c0f0cda1cc179e15eeea6ad1d1 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 25 Nov 2024 18:42:05 -0500 Subject: [PATCH 06/14] Styler --- R/ard_event_rates.R | 2 +- tests/testthat/_snaps/ard_event_rates.md | 2 +- tests/testthat/test-ard_event_rates.R | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ard_event_rates.R b/R/ard_event_rates.R index a2384871..73e72142 100644 --- a/R/ard_event_rates.R +++ b/R/ard_event_rates.R @@ -108,7 +108,7 @@ ard_event_rates <- function(data, if (is.data.frame(denominator) && !is_empty(intersect(by, names(denominator)))) { df_na_nan_denom <- is.na(denominator[intersect(by, names(denominator))]) | - apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) + apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) if (any(df_na_nan_denom)) { rows_with_na_denom <- apply(df_na_nan_denom, MARGIN = 1, any) cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na_denom)}} row{?s} from {.arg denominator} with diff --git a/tests/testthat/_snaps/ard_event_rates.md b/tests/testthat/_snaps/ard_event_rates.md index 46409589..20f7c55b 100644 --- a/tests/testthat/_snaps/ard_event_rates.md +++ b/tests/testthat/_snaps/ard_event_rates.md @@ -33,7 +33,7 @@ --- Code - print(ard_event_rates(group_by(cards::ADAE, TRTA), variables = AESOC, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") + print(ard_event_rates(dplyr::group_by(cards::ADAE, TRTA), variables = AESOC, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") Message {cards} data frame: 207 x 11 Output diff --git a/tests/testthat/test-ard_event_rates.R b/tests/testthat/test-ard_event_rates.R index 68e5a93a..652979ba 100644 --- a/tests/testthat/test-ard_event_rates.R +++ b/tests/testthat/test-ard_event_rates.R @@ -33,7 +33,7 @@ test_that("ard_event_rates() works with default settings", { # with denominator expect_snapshot( ard_event_rates( - cards::ADAE |> group_by(TRTA), + cards::ADAE |> dplyr::group_by(TRTA), variables = AESOC, id = USUBJID, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) @@ -77,7 +77,7 @@ test_that("ard_event_rates(ordered) works", { # pre-ordered factor variable adae <- cards::ADAE |> - mutate(AESEV = factor(cards::ADAE$AESEV, ordered = TRUE)) + dplyr::mutate(AESEV = factor(cards::ADAE$AESEV, ordered = TRUE)) expect_silent( res <- ard_event_rates( From 299a50521b0fe91570e734f220f2d817475b663b Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 8 Jan 2025 19:06:02 -0500 Subject: [PATCH 07/14] Refactor as ard_categorical_max --- NAMESPACE | 2 +- ...rd_event_rates.R => ard_categorical_max.R} | 96 +++++----- ..._event_rates.Rd => ard_categorical_max.Rd} | 45 ++--- tests/testthat/_snaps/ard_categorical_max.md | 170 ++++++++++++++++++ ...ent_rates.R => test-ard_categorical_max.R} | 119 +++++------- 5 files changed, 274 insertions(+), 158 deletions(-) rename R/{ard_event_rates.R => ard_categorical_max.R} (63%) rename man/{ard_event_rates.Rd => ard_categorical_max.Rd} (62%) create mode 100644 tests/testthat/_snaps/ard_categorical_max.md rename tests/testthat/{test-ard_event_rates.R => test-ard_categorical_max.R} (65%) diff --git a/NAMESPACE b/NAMESPACE index a7b53597..d7432de8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ export(ard_car_anova) export(ard_car_vif) export(ard_categorical) export(ard_categorical_ci) +export(ard_categorical_max) export(ard_continuous) export(ard_continuous_ci) export(ard_dichotomous) @@ -34,7 +35,6 @@ export(ard_effectsize_hedges_g) export(ard_effectsize_paired_cohens_d) export(ard_effectsize_paired_hedges_g) export(ard_emmeans_mean_difference) -export(ard_event_rates) export(ard_missing) export(ard_regression) export(ard_regression_basic) diff --git a/R/ard_event_rates.R b/R/ard_categorical_max.R similarity index 63% rename from R/ard_event_rates.R rename to R/ard_categorical_max.R index 73e72142..874e652f 100644 --- a/R/ard_event_rates.R +++ b/R/ard_categorical_max.R @@ -1,63 +1,50 @@ -#' ARD to Calculate Event Occurrence Rates by ID +#' ARD to Calculate Categorical Occurrence Rates by Maximum Level Per Unique ID #' -#' Function calculates event occurrences rates per unique ID. +#' Function calculates categorical variable level occurrences rates by maximum level per unique ID. #' Each variable in `variables` is evaluated independently and then results for all variables are stacked. -#' For non-ordered variables (`ordered = FALSE`), each level that occurs per unique ID will be counted once. -#' For ordered variables (`ordered = TRUE`), only the highest-ordered level will be counted for each unique ID. +#' Only the highest-ordered level will be counted for each unique ID. +#' Unordered, non-numeric variables will be converted to factor and the default level order used for ordering. #' #' @inheritParams cards::ard_categorical #' @inheritParams cards::ard_stack #' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' The factor variables for which event rates (for each level) will be calculated. +#' The categorical variables for which occurrence rates per unique ID (by maximum level) will be calculated. #' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' Argument used to subset `data` to identify rows in `data` to calculate event rates. +#' Argument used to subset `data` to identify rows in `data` to calculate categorical variable level occurrence rates. #' @param denominator (`data.frame`, `integer`)\cr #' Used to define the denominator and enhance the output. #' The argument is optional. If not specified, `data` will be used as `denominator`. #' - the univariate tabulations of the `by` variables are calculated with `denominator` when a data frame is passed, #' e.g. tabulation of the treatment assignment counts that may appear in the header of a table. -#' @param ordered (`logical`)\cr -#' Specifies whether factor variables specified by `variables` are ordered or not. If ordered, only the -#' highest-ordered level will be counted for each unique value of `id`. Otherwise, each level that occurs per unique -#' value of `id` will be counted once. Must be the same length as `variables`. Defaults to `TRUE` for ordered factor -#' variables and `FALSE` otherwise. +#' @param quiet (scalar `logical`)\cr +#' Logical indicating whether to suppress additional messaging. Default is `FALSE`. #' #' @return an ARD data frame of class 'card' -#' @name ard_event_rates +#' @name ard_categorical_max #' #' @examples -#' # Example 1 - Event Rates ------------------------------------ -#' ard_event_rates( +#' # Occurrence Rates by Max Level (Highest Severity) -------------------------- +#' ard_categorical_max( #' cards::ADAE, -#' variables = c(AEBODSYS, AESOC), +#' variables = c(AESER, AESEV), #' id = USUBJID, #' by = TRTA, #' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) #' ) -#' -#' # Example 2 - Event Rates by Highest Severity ---------------- -#' ard_event_rates( -#' cards::ADAE, -#' variables = AESEV, -#' id = USUBJID, -#' by = TRTA, -#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), -#' ordered = TRUE -#' ) NULL -#' @rdname ard_event_rates +#' @rdname ard_categorical_max #' @export -ard_event_rates <- function(data, - variables, - id, - by = dplyr::group_vars(data), - statistic = everything() ~ c("n", "p", "N"), - denominator = NULL, - fmt_fn = NULL, - stat_label = everything() ~ cards::default_stat_labels(), - ordered = sapply(data[variables], is.ordered), - ...) { +ard_categorical_max <- function(data, + variables, + id, + by = dplyr::group_vars(data), + statistic = everything() ~ c("n", "p", "N"), + denominator = NULL, + fmt_fn = NULL, + stat_label = everything() ~ cards::default_stat_labels(), + quiet = TRUE, + ...) { set_cli_abort_call() # check inputs --------------------------------------------------------------- @@ -86,13 +73,21 @@ ard_event_rates <- function(data, return(dplyr::tibble() |> cards::as_card()) } - # check the ordered argument - check_logical(ordered) - if (length(ordered) != length(variables)) { - cli::cli_abort( - "Argument {.arg ordered} has length {length(ordered)} but must be the same length as {.arg variables} ({length(variables)}).", - call = get_cli_abort_call() - ) + # order variables + for (v in variables) { + if (is.character(data[[v]])) { + lvls <- .unique_and_sorted(data[[v]]) + vec <- cli::cli_vec(lvls, style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ")) + if (!quiet) { + cli::cli_inform( + paste( + "The {.var {v}} variable is {.obj_type_friendly {data[[v]]}}. It has been converted to a {.cls factor} variable with", + "the following ordered levels: {.val {vec}}." + ) + ) + } + data[[v]] <- factor(data[[v]], levels = lvls, ordered = TRUE) + } } # drop missing values -------------------------------------------------------- @@ -108,7 +103,7 @@ ard_event_rates <- function(data, if (is.data.frame(denominator) && !is_empty(intersect(by, names(denominator)))) { df_na_nan_denom <- is.na(denominator[intersect(by, names(denominator))]) | - apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) + apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) if (any(df_na_nan_denom)) { rows_with_na_denom <- apply(df_na_nan_denom, MARGIN = 1, any) cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na_denom)}} row{?s} from {.arg denominator} with @@ -136,15 +131,12 @@ ard_event_rates <- function(data, lst_results <- list() for (var in variables) { - ord <- (is_named(ordered) && ordered[var]) || (!is_named(ordered) && ordered[which(variables == var)]) - if (ord) data[[var]] <- factor(data[[var]], ordered = TRUE) - lst_results <- lst_results |> append( ard_categorical( data = data |> - dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator)), if (!ord) var))), + dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator))))), variables = all_of(var), by = all_of(by), statistic = statistic, @@ -155,16 +147,14 @@ ard_event_rates <- function(data, list() ) - if (ord) { - lst_results[[length(lst_results)]] <- lst_results[[length(lst_results)]] |> - dplyr::mutate(variable_level = as.list(as.character(unlist(.data$variable_level)))) - } + lst_results[[length(lst_results)]] <- lst_results[[length(lst_results)]] |> + dplyr::mutate(variable_level = as.list(as.character(unlist(.data$variable_level)))) } # combine results ------------------------------------------------------------ result <- lst_results |> dplyr::bind_rows() |> - dplyr::mutate(context = "event_rates") |> + dplyr::mutate(context = "categorical_max") |> cards::tidy_ard_column_order() |> cards::tidy_ard_row_order() diff --git a/man/ard_event_rates.Rd b/man/ard_categorical_max.Rd similarity index 62% rename from man/ard_event_rates.Rd rename to man/ard_categorical_max.Rd index ba3a3a6f..213418b6 100644 --- a/man/ard_event_rates.Rd +++ b/man/ard_categorical_max.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_event_rates.R -\name{ard_event_rates} -\alias{ard_event_rates} -\title{ARD to Calculate Event Occurrence Rates by ID} +% Please edit documentation in R/ard_categorical_max.R +\name{ard_categorical_max} +\alias{ard_categorical_max} +\title{ARD to Calculate Categorical Occurrence Rates by Maximum Level Per Unique ID} \usage{ -ard_event_rates( +ard_categorical_max( data, variables, id, @@ -13,7 +13,7 @@ ard_event_rates( denominator = NULL, fmt_fn = NULL, stat_label = everything() ~ cards::default_stat_labels(), - ordered = sapply(data[variables], is.ordered), + quiet = TRUE, ... ) } @@ -22,10 +22,10 @@ ard_event_rates( a data frame} \item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -The factor variables for which event rates (for each level) will be calculated.} +The categorical variables for which occurrence rates per unique ID (by maximum level) will be calculated.} \item{id}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -Argument used to subset \code{data} to identify rows in \code{data} to calculate event rates.} +Argument used to subset \code{data} to identify rows in \code{data} to calculate categorical variable level occurrence rates.} \item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr columns to tabulate by in the series of ARD function calls. @@ -56,11 +56,8 @@ the list element is either a named list or a list of formulas defining the statistic labels, e.g. \code{everything() ~ list(n = "n", p = "pct")} or \code{everything() ~ list(n ~ "n", p ~ "pct")}.} -\item{ordered}{(\code{logical})\cr -Specifies whether factor variables specified by \code{variables} are ordered or not. If ordered, only the -highest-ordered level will be counted for each unique value of \code{id}. Otherwise, each level that occurs per unique -value of \code{id} will be counted once. Must be the same length as \code{variables}. Defaults to \code{TRUE} for ordered factor -variables and \code{FALSE} otherwise.} +\item{quiet}{(scalar \code{logical})\cr +Logical indicating whether to suppress additional messaging. Default is \code{FALSE}.} \item{...}{Arguments passed to methods.} } @@ -68,28 +65,18 @@ variables and \code{FALSE} otherwise.} an ARD data frame of class 'card' } \description{ -Function calculates event occurrences rates per unique ID. +Function calculates categorical variable level occurrences rates by maximum level per unique ID. Each variable in \code{variables} is evaluated independently and then results for all variables are stacked. -For non-ordered variables (\code{ordered = FALSE}), each level that occurs per unique ID will be counted once. -For ordered variables (\code{ordered = TRUE}), only the highest-ordered level will be counted for each unique ID. +Only the highest-ordered level will be counted for each unique ID. +Unordered, non-numeric variables will be converted to factor and the default level order used for ordering. } \examples{ -# Example 1 - Event Rates ------------------------------------ -ard_event_rates( +# Occurrence Rates by Max Level (Highest Severity) -------------------------- +ard_categorical_max( cards::ADAE, - variables = c(AEBODSYS, AESOC), + variables = c(AESER, AESEV), id = USUBJID, by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) - -# Example 2 - Event Rates by Highest Severity ---------------- -ard_event_rates( - cards::ADAE, - variables = AESEV, - id = USUBJID, - by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), - ordered = TRUE -) } diff --git a/tests/testthat/_snaps/ard_categorical_max.md b/tests/testthat/_snaps/ard_categorical_max.md new file mode 100644 index 00000000..872ccb8c --- /dev/null +++ b/tests/testthat/_snaps/ard_categorical_max.md @@ -0,0 +1,170 @@ +# ard_categorical_max() works with default settings + + Code + print(res, n = 20, columns = "all") + Message + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESEV MILD categori… n n 36 0 + 2 TRTA Placebo AESEV MILD categori… N N 301 0 + 3 TRTA Placebo AESEV MILD categori… p % 0.12 + 4 TRTA Placebo AESEV MODERATE categori… n n 26 0 + 5 TRTA Placebo AESEV MODERATE categori… N N 301 0 + 6 TRTA Placebo AESEV MODERATE categori… p % 0.086 + 7 TRTA Placebo AESEV SEVERE categori… n n 7 0 + 8 TRTA Placebo AESEV SEVERE categori… N N 301 0 + 9 TRTA Placebo AESEV SEVERE categori… p % 0.023 + 10 TRTA Xanomeli… AESEV MILD categori… n n 22 0 + 11 TRTA Xanomeli… AESEV MILD categori… N N 455 0 + 12 TRTA Xanomeli… AESEV MILD categori… p % 0.048 + 13 TRTA Xanomeli… AESEV MODERATE categori… n n 49 0 + 14 TRTA Xanomeli… AESEV MODERATE categori… N N 455 0 + 15 TRTA Xanomeli… AESEV MODERATE categori… p % 0.108 + 16 TRTA Xanomeli… AESEV SEVERE categori… n n 8 0 + 17 TRTA Xanomeli… AESEV SEVERE categori… N N 455 0 + 18 TRTA Xanomeli… AESEV SEVERE categori… p % 0.018 + 19 TRTA Xanomeli… AESEV MILD categori… n n 19 0 + 20 TRTA Xanomeli… AESEV MILD categori… N N 435 0 + Message + i 7 more rows + i Use `print(n = ...)` to see more rows + +--- + + Code + print(ard_categorical_max(dplyr::group_by(cards::ADAE, TRTA), variables = AESEV, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") + Message + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESEV MILD categori… n n 36 0 + 2 TRTA Placebo AESEV MILD categori… N N 86 0 + 3 TRTA Placebo AESEV MILD categori… p % 0.419 + 4 TRTA Placebo AESEV MODERATE categori… n n 26 0 + 5 TRTA Placebo AESEV MODERATE categori… N N 86 0 + 6 TRTA Placebo AESEV MODERATE categori… p % 0.302 + 7 TRTA Placebo AESEV SEVERE categori… n n 7 0 + 8 TRTA Placebo AESEV SEVERE categori… N N 86 0 + 9 TRTA Placebo AESEV SEVERE categori… p % 0.081 + 10 TRTA Xanomeli… AESEV MILD categori… n n 22 0 + 11 TRTA Xanomeli… AESEV MILD categori… N N 84 0 + 12 TRTA Xanomeli… AESEV MILD categori… p % 0.262 + 13 TRTA Xanomeli… AESEV MODERATE categori… n n 49 0 + 14 TRTA Xanomeli… AESEV MODERATE categori… N N 84 0 + 15 TRTA Xanomeli… AESEV MODERATE categori… p % 0.583 + 16 TRTA Xanomeli… AESEV SEVERE categori… n n 8 0 + 17 TRTA Xanomeli… AESEV SEVERE categori… N N 84 0 + 18 TRTA Xanomeli… AESEV SEVERE categori… p % 0.095 + 19 TRTA Xanomeli… AESEV MILD categori… n n 19 0 + 20 TRTA Xanomeli… AESEV MILD categori… N N 84 0 + Message + i 7 more rows + i Use `print(n = ...)` to see more rows + +# ard_categorical_max(statistic) works + + Code + ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), statistic = ~"n") + Message + {cards} data frame: 9 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AESEV MILD n n 36 + 2 TRTA Placebo AESEV MODERATE n n 26 + 3 TRTA Placebo AESEV SEVERE n n 7 + 4 TRTA Xanomeli… AESEV MILD n n 22 + 5 TRTA Xanomeli… AESEV MODERATE n n 49 + 6 TRTA Xanomeli… AESEV SEVERE n n 8 + 7 TRTA Xanomeli… AESEV MILD n n 19 + 8 TRTA Xanomeli… AESEV MODERATE n n 42 + 9 TRTA Xanomeli… AESEV SEVERE n n 16 + Message + i 4 more variables: context, fmt_fn, warning, error + +# ard_categorical_max(quiet) works + + Code + ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), quiet = FALSE) + Message + The `AESEV` variable is a character vector. It has been converted to a variable with the following ordered levels: "MILD" < "MODERATE" < "SEVERE". + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AESEV MILD n n 36 + 2 TRTA Placebo AESEV MILD N N 86 + 3 TRTA Placebo AESEV MILD p % 0.419 + 4 TRTA Placebo AESEV MODERATE n n 26 + 5 TRTA Placebo AESEV MODERATE N N 86 + 6 TRTA Placebo AESEV MODERATE p % 0.302 + 7 TRTA Placebo AESEV SEVERE n n 7 + 8 TRTA Placebo AESEV SEVERE N N 86 + 9 TRTA Placebo AESEV SEVERE p % 0.081 + 10 TRTA Xanomeli… AESEV MILD n n 22 + Message + i 17 more rows + i Use `print(n = ...)` to see more rows + i 4 more variables: context, fmt_fn, warning, error + +# ard_categorical_max() works with pre-ordered factor variables + + Code + print(res, n = 20, columns = "all") + Message + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error + 1 TRTA Placebo AESEV MILD categori… n n 36 0 + 2 TRTA Placebo AESEV MILD categori… N N 86 0 + 3 TRTA Placebo AESEV MILD categori… p % 0.419 + 4 TRTA Placebo AESEV MODERATE categori… n n 26 0 + 5 TRTA Placebo AESEV MODERATE categori… N N 86 0 + 6 TRTA Placebo AESEV MODERATE categori… p % 0.302 + 7 TRTA Placebo AESEV SEVERE categori… n n 7 0 + 8 TRTA Placebo AESEV SEVERE categori… N N 86 0 + 9 TRTA Placebo AESEV SEVERE categori… p % 0.081 + 10 TRTA Xanomeli… AESEV MILD categori… n n 22 0 + 11 TRTA Xanomeli… AESEV MILD categori… N N 84 0 + 12 TRTA Xanomeli… AESEV MILD categori… p % 0.262 + 13 TRTA Xanomeli… AESEV MODERATE categori… n n 49 0 + 14 TRTA Xanomeli… AESEV MODERATE categori… N N 84 0 + 15 TRTA Xanomeli… AESEV MODERATE categori… p % 0.583 + 16 TRTA Xanomeli… AESEV SEVERE categori… n n 8 0 + 17 TRTA Xanomeli… AESEV SEVERE categori… N N 84 0 + 18 TRTA Xanomeli… AESEV SEVERE categori… p % 0.095 + 19 TRTA Xanomeli… AESEV MILD categori… n n 19 0 + 20 TRTA Xanomeli… AESEV MILD categori… N N 84 0 + Message + i 7 more rows + i Use `print(n = ...)` to see more rows + +# ard_categorical_max() errors with incomplete factor columns + + Code + ard_categorical_max(dplyr::mutate(cards::ADAE, AESOC = factor(AESOC, levels = character( + 0))), variables = AESOC, id = USUBJID, by = TRTA) + Message + * Removing 1191 rows from `data` with NA or NaN values in "TRTA" and "AESOC" columns. + Condition + Error in `ard_categorical_max()`: + ! Factors with empty "levels" attribute are not allowed, which was identified in column "AESOC". + +--- + + Code + ard_categorical_max(dplyr::mutate(cards::ADAE, SEX = factor(SEX, levels = c("F", + "M", NA), exclude = NULL)), variables = SEX, id = USUBJID, by = TRTA) + Condition + Error in `ard_categorical_max()`: + ! Factors with NA levels are not allowed, which are present in column "SEX". + +# ard_categorical_max() works without any variables + + Code + ard_categorical_max(data = cards::ADAE, variables = starts_with("xxxx"), id = USUBJID, + by = c(TRTA, AESEV)) + Message + {cards} data frame: 0 x 0 + Output + data frame with 0 columns and 0 rows + diff --git a/tests/testthat/test-ard_event_rates.R b/tests/testthat/test-ard_categorical_max.R similarity index 65% rename from tests/testthat/test-ard_event_rates.R rename to tests/testthat/test-ard_categorical_max.R index 652979ba..4497db76 100644 --- a/tests/testthat/test-ard_event_rates.R +++ b/tests/testthat/test-ard_categorical_max.R @@ -1,10 +1,10 @@ -test_that("ard_event_rates() works with default settings", { +test_that("ard_categorical_max() works with default settings", { withr::local_options(list(width = 200)) expect_silent( - res <- ard_event_rates( + res <- ard_categorical_max( cards::ADAE, - variables = AESOC, + variables = AESEV, id = USUBJID, by = TRTA ) @@ -15,7 +15,7 @@ test_that("ard_event_rates() works with default settings", { res |> dplyr::filter( group1_level == "Placebo", - variable_level == "CARDIAC DISORDERS", + variable_level == "SEVERE", stat_name == "n" ) |> cards::get_ard_statistics(), @@ -23,18 +23,18 @@ test_that("ard_event_rates() works with default settings", { n = cards::ADAE |> dplyr::filter( TRTA == "Placebo", - AESOC == "CARDIAC DISORDERS" + AESEV == "SEVERE" ) |> - dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA", "AESOC"))) |> + dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA", "AESEV"))) |> nrow() ) ) # with denominator expect_snapshot( - ard_event_rates( + ard_categorical_max( cards::ADAE |> dplyr::group_by(TRTA), - variables = AESOC, + variables = AESEV, id = USUBJID, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) |> @@ -43,27 +43,27 @@ test_that("ard_event_rates() works with default settings", { # with multiple variables expect_silent( - res2 <- ard_event_rates( + res2 <- ard_categorical_max( cards::ADAE, - variables = c(SEX, AESOC), + variables = c(AESEV, AESER), id = USUBJID, by = TRTA ) ) - expect_equal(unique(res2$variable), c("SEX", "AESOC")) + expect_equal(unique(res2$variable), c("AESEV", "AESER")) expect_equal( res, - res2[-c(1:18), ] + res2[-c(28:45), ] ) }) -test_that("ard_event_rates(statistic) works", { +test_that("ard_categorical_max(statistic) works", { withr::local_options(list(width = 200)) expect_snapshot( - ard_event_rates( + ard_categorical_max( cards::ADAE, - variables = SEX, + variables = AESEV, id = USUBJID, by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), @@ -72,7 +72,22 @@ test_that("ard_event_rates(statistic) works", { ) }) -test_that("ard_event_rates(ordered) works", { +test_that("ard_categorical_max(quiet) works", { + withr::local_options(list(width = 200)) + + expect_snapshot( + ard_categorical_max( + cards::ADAE, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + quiet = FALSE + ) + ) +}) + +test_that("ard_categorical_max() works with pre-ordered factor variables", { withr::local_options(list(width = 200)) # pre-ordered factor variable @@ -80,7 +95,7 @@ test_that("ard_event_rates(ordered) works", { dplyr::mutate(AESEV = factor(cards::ADAE$AESEV, ordered = TRUE)) expect_silent( - res <- ard_event_rates( + res <- ard_categorical_max( cards::ADAE, variables = AESEV, id = USUBJID, @@ -111,16 +126,16 @@ test_that("ard_event_rates(ordered) works", { ) ) - res_unord <- ard_event_rates( + res_unord <- ard_categorical_max( cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) - expect_true(res$stat[[1]] != res_unord$stat[[1]]) + expect_equal(res$stat[[1]], res_unord$stat[[1]]) - res2 <- ard_event_rates( + res2 <- ard_categorical_max( adae, variables = AESEV, id = USUBJID, @@ -131,7 +146,7 @@ test_that("ard_event_rates(ordered) works", { # multiple variables expect_silent( - res3 <- ard_event_rates( + res3 <- ard_categorical_max( adae, variables = c(SEX, AESEV), id = USUBJID, @@ -144,7 +159,7 @@ test_that("ard_event_rates(ordered) works", { # named vector expect_silent( - res4 <- ard_event_rates( + res4 <- ard_categorical_max( adae, variables = c(SEX, AESEV), id = USUBJID, @@ -154,27 +169,13 @@ test_that("ard_event_rates(ordered) works", { ) ) expect_equal(res3, res4) - - # error - length does not match - expect_snapshot( - ard_event_rates( - adae, - variables = c(SEX, AESEV), - id = USUBJID, - by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), - ordered = TRUE - ), - error = TRUE - ) - expect_equal(res, res2) }) -test_that("ard_event_rates() errors with incomplete factor columns", { +test_that("ard_categorical_max() errors with incomplete factor columns", { # Check error when factors have no levels expect_snapshot( error = TRUE, - ard_event_rates( + ard_categorical_max( cards::ADAE |> dplyr::mutate(AESOC = factor(AESOC, levels = character(0))), variables = AESOC, @@ -186,7 +187,7 @@ test_that("ard_event_rates() errors with incomplete factor columns", { # Check error when factor has NA level expect_snapshot( error = TRUE, - ard_event_rates( + ard_categorical_max( cards::ADAE |> dplyr::mutate(SEX = factor(SEX, levels = c("F", "M", NA), exclude = NULL)), variables = SEX, @@ -196,41 +197,9 @@ test_that("ard_event_rates() errors with incomplete factor columns", { ) }) -test_that("ard_hierarchical_count() works with by variable not present in 'denominator'", { - expect_silent( - ard_events_with_by <- ard_event_rates( - data = cards::ADAE, - variables = AESOC, - id = USUBJID, - by = c(TRTA, AESEV), - statistic = ~"n" - ) - ) - - expect_equal( - ard_events_with_by |> - dplyr::filter( - group1_level == "Placebo", - group2_level == "MILD", - variable_level == "CARDIAC DISORDERS" - ) |> - cards::get_ard_statistics(), - list( - n = cards::ADAE |> - dplyr::filter( - TRTA == "Placebo", - AESEV == "MILD", - AESOC == "CARDIAC DISORDERS" - ) |> - dplyr::slice_tail(n = 1L, by = all_of(c("USUBJID", "TRTA", "AESEV", "AESOC"))) |> - nrow() - ) - ) -}) - -test_that("ard_event_rates() works without any variables", { +test_that("ard_categorical_max() works without any variables", { expect_snapshot( - ard_event_rates( + ard_categorical_max( data = cards::ADAE, variables = starts_with("xxxx"), id = USUBJID, @@ -239,9 +208,9 @@ test_that("ard_event_rates() works without any variables", { ) }) -test_that("ard_event_rates() follows ard structure", { +test_that("ard_categorical_max() follows ard structure", { expect_silent( - ard_event_rates( + ard_categorical_max( cards::ADAE, variables = AESOC, id = USUBJID From 05ac1df360fbc7ad959773481c9af650416567a6 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 8 Jan 2025 19:09:25 -0500 Subject: [PATCH 08/14] Delete old file --- R/ard_categorical_max.R | 2 +- tests/testthat/_snaps/ard_event_rates.md | 151 ----------------------- 2 files changed, 1 insertion(+), 152 deletions(-) delete mode 100644 tests/testthat/_snaps/ard_event_rates.md diff --git a/R/ard_categorical_max.R b/R/ard_categorical_max.R index 874e652f..3c2d4271 100644 --- a/R/ard_categorical_max.R +++ b/R/ard_categorical_max.R @@ -103,7 +103,7 @@ ard_categorical_max <- function(data, if (is.data.frame(denominator) && !is_empty(intersect(by, names(denominator)))) { df_na_nan_denom <- is.na(denominator[intersect(by, names(denominator))]) | - apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) + apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) if (any(df_na_nan_denom)) { rows_with_na_denom <- apply(df_na_nan_denom, MARGIN = 1, any) cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na_denom)}} row{?s} from {.arg denominator} with diff --git a/tests/testthat/_snaps/ard_event_rates.md b/tests/testthat/_snaps/ard_event_rates.md deleted file mode 100644 index 20f7c55b..00000000 --- a/tests/testthat/_snaps/ard_event_rates.md +++ /dev/null @@ -1,151 +0,0 @@ -# ard_event_rates() works with default settings - - Code - print(res, n = 20, columns = "all") - Message - {cards} data frame: 207 x 11 - Output - group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error - 1 TRTA Placebo AESOC CARDIAC … event_ra… n n 13 0 - 2 TRTA Placebo AESOC CARDIAC … event_ra… N N 301 0 - 3 TRTA Placebo AESOC CARDIAC … event_ra… p % 0.043 - 4 TRTA Placebo AESOC CONGENIT… event_ra… n n 0 0 - 5 TRTA Placebo AESOC CONGENIT… event_ra… N N 301 0 - 6 TRTA Placebo AESOC CONGENIT… event_ra… p % 0 - 7 TRTA Placebo AESOC EAR AND … event_ra… n n 1 0 - 8 TRTA Placebo AESOC EAR AND … event_ra… N N 301 0 - 9 TRTA Placebo AESOC EAR AND … event_ra… p % 0.003 - 10 TRTA Placebo AESOC EYE DISO… event_ra… n n 4 0 - 11 TRTA Placebo AESOC EYE DISO… event_ra… N N 301 0 - 12 TRTA Placebo AESOC EYE DISO… event_ra… p % 0.013 - 13 TRTA Placebo AESOC GASTROIN… event_ra… n n 17 0 - 14 TRTA Placebo AESOC GASTROIN… event_ra… N N 301 0 - 15 TRTA Placebo AESOC GASTROIN… event_ra… p % 0.056 - 16 TRTA Placebo AESOC GENERAL … event_ra… n n 21 0 - 17 TRTA Placebo AESOC GENERAL … event_ra… N N 301 0 - 18 TRTA Placebo AESOC GENERAL … event_ra… p % 0.07 - 19 TRTA Placebo AESOC HEPATOBI… event_ra… n n 1 0 - 20 TRTA Placebo AESOC HEPATOBI… event_ra… N N 301 0 - Message - i 187 more rows - i Use `print(n = ...)` to see more rows - ---- - - Code - print(ard_event_rates(dplyr::group_by(cards::ADAE, TRTA), variables = AESOC, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") - Message - {cards} data frame: 207 x 11 - Output - group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error - 1 TRTA Placebo AESOC CARDIAC … event_ra… n n 13 0 - 2 TRTA Placebo AESOC CARDIAC … event_ra… N N 86 0 - 3 TRTA Placebo AESOC CARDIAC … event_ra… p % 0.151 - 4 TRTA Placebo AESOC CONGENIT… event_ra… n n 0 0 - 5 TRTA Placebo AESOC CONGENIT… event_ra… N N 86 0 - 6 TRTA Placebo AESOC CONGENIT… event_ra… p % 0 - 7 TRTA Placebo AESOC EAR AND … event_ra… n n 1 0 - 8 TRTA Placebo AESOC EAR AND … event_ra… N N 86 0 - 9 TRTA Placebo AESOC EAR AND … event_ra… p % 0.012 - 10 TRTA Placebo AESOC EYE DISO… event_ra… n n 4 0 - 11 TRTA Placebo AESOC EYE DISO… event_ra… N N 86 0 - 12 TRTA Placebo AESOC EYE DISO… event_ra… p % 0.047 - 13 TRTA Placebo AESOC GASTROIN… event_ra… n n 17 0 - 14 TRTA Placebo AESOC GASTROIN… event_ra… N N 86 0 - 15 TRTA Placebo AESOC GASTROIN… event_ra… p % 0.198 - 16 TRTA Placebo AESOC GENERAL … event_ra… n n 21 0 - 17 TRTA Placebo AESOC GENERAL … event_ra… N N 86 0 - 18 TRTA Placebo AESOC GENERAL … event_ra… p % 0.244 - 19 TRTA Placebo AESOC HEPATOBI… event_ra… n n 1 0 - 20 TRTA Placebo AESOC HEPATOBI… event_ra… N N 86 0 - Message - i 187 more rows - i Use `print(n = ...)` to see more rows - -# ard_event_rates(statistic) works - - Code - ard_event_rates(cards::ADAE, variables = SEX, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), statistic = ~"n") - Message - {cards} data frame: 6 x 11 - Output - group1 group1_level variable variable_level stat_name stat_label stat - 1 TRTA Placebo SEX F n n 40 - 2 TRTA Placebo SEX M n n 29 - 3 TRTA Xanomeli… SEX F n n 37 - 4 TRTA Xanomeli… SEX M n n 42 - 5 TRTA Xanomeli… SEX F n n 44 - 6 TRTA Xanomeli… SEX M n n 33 - Message - i 4 more variables: context, fmt_fn, warning, error - -# ard_event_rates(ordered) works - - Code - print(res, n = 20, columns = "all") - Message - {cards} data frame: 27 x 11 - Output - group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error - 1 TRTA Placebo AESEV MILD event_ra… n n 36 0 - 2 TRTA Placebo AESEV MILD event_ra… N N 86 0 - 3 TRTA Placebo AESEV MILD event_ra… p % 0.419 - 4 TRTA Placebo AESEV MODERATE event_ra… n n 26 0 - 5 TRTA Placebo AESEV MODERATE event_ra… N N 86 0 - 6 TRTA Placebo AESEV MODERATE event_ra… p % 0.302 - 7 TRTA Placebo AESEV SEVERE event_ra… n n 7 0 - 8 TRTA Placebo AESEV SEVERE event_ra… N N 86 0 - 9 TRTA Placebo AESEV SEVERE event_ra… p % 0.081 - 10 TRTA Xanomeli… AESEV MILD event_ra… n n 22 0 - 11 TRTA Xanomeli… AESEV MILD event_ra… N N 84 0 - 12 TRTA Xanomeli… AESEV MILD event_ra… p % 0.262 - 13 TRTA Xanomeli… AESEV MODERATE event_ra… n n 49 0 - 14 TRTA Xanomeli… AESEV MODERATE event_ra… N N 84 0 - 15 TRTA Xanomeli… AESEV MODERATE event_ra… p % 0.583 - 16 TRTA Xanomeli… AESEV SEVERE event_ra… n n 8 0 - 17 TRTA Xanomeli… AESEV SEVERE event_ra… N N 84 0 - 18 TRTA Xanomeli… AESEV SEVERE event_ra… p % 0.095 - 19 TRTA Xanomeli… AESEV MILD event_ra… n n 19 0 - 20 TRTA Xanomeli… AESEV MILD event_ra… N N 84 0 - Message - i 7 more rows - i Use `print(n = ...)` to see more rows - ---- - - Code - ard_event_rates(adae, variables = c(SEX, AESEV), id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), ordered = TRUE) - Condition - Error in `ard_event_rates()`: - ! Argument `ordered` has length 1 but must be the same length as `variables` (2). - -# ard_event_rates() errors with incomplete factor columns - - Code - ard_event_rates(dplyr::mutate(cards::ADAE, AESOC = factor(AESOC, levels = character( - 0))), variables = AESOC, id = USUBJID, by = TRTA) - Message - * Removing 1191 rows from `data` with NA or NaN values in "TRTA" and "AESOC" columns. - Condition - Error in `ard_event_rates()`: - ! Factors with empty "levels" attribute are not allowed, which was identified in column "AESOC". - ---- - - Code - ard_event_rates(dplyr::mutate(cards::ADAE, SEX = factor(SEX, levels = c("F", - "M", NA), exclude = NULL)), variables = SEX, id = USUBJID, by = TRTA) - Condition - Error in `ard_event_rates()`: - ! Factors with NA levels are not allowed, which are present in column "SEX". - -# ard_event_rates() works without any variables - - Code - ard_event_rates(data = cards::ADAE, variables = starts_with("xxxx"), id = USUBJID, - by = c(TRTA, AESEV)) - Message - {cards} data frame: 0 x 0 - Output - data frame with 0 columns and 0 rows - From 0bd60b5f6a3286299f16ce3bf791951c4b73f749 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 8 Jan 2025 19:13:54 -0500 Subject: [PATCH 09/14] Update pkgdown --- _pkgdown.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index e1cfcec2..f6e21349 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -88,7 +88,7 @@ reference: - ard_categorical_ci.data.frame - ard_regression - ard_regression_basic - - ard_event_rates + - ard_categorical_max - title: "Helpers" - contents: From 34ce9ac3d6a79162ee1077ba86868ae826ad419f Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 10 Jan 2025 18:03:49 -0500 Subject: [PATCH 10/14] Update ard_categorical_max --- R/ard_categorical_max.R | 95 +++++--------------- man/ard_categorical_max.Rd | 3 +- tests/testthat/_snaps/ard_categorical_max.md | 4 +- tests/testthat/test-ard_categorical_max.R | 12 ++- 4 files changed, 35 insertions(+), 79 deletions(-) diff --git a/R/ard_categorical_max.R b/R/ard_categorical_max.R index 3c2d4271..9e52c790 100644 --- a/R/ard_categorical_max.R +++ b/R/ard_categorical_max.R @@ -29,7 +29,8 @@ #' variables = c(AESER, AESEV), #' id = USUBJID, #' by = TRTA, -#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) +#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), +#' quiet = FALSE #' ) NULL @@ -73,83 +74,35 @@ ard_categorical_max <- function(data, return(dplyr::tibble() |> cards::as_card()) } - # order variables + # print default order of character variable levels --------------------------- for (v in variables) { if (is.character(data[[v]])) { lvls <- .unique_and_sorted(data[[v]]) - vec <- cli::cli_vec(lvls, style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ")) - if (!quiet) { - cli::cli_inform( - paste( - "The {.var {v}} variable is {.obj_type_friendly {data[[v]]}}. It has been converted to a {.cls factor} variable with", - "the following ordered levels: {.val {vec}}." - ) - ) - } - data[[v]] <- factor(data[[v]], levels = lvls, ordered = TRUE) - } - } - - # drop missing values -------------------------------------------------------- - df_na_nan <- is.na(data[c(by, variables)]) | apply(data[c(by, variables)], MARGIN = 2, is.nan) - if (any(df_na_nan)) { - rows_with_na <- apply(df_na_nan, MARGIN = 1, any) - cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na)}} row{?s} from {.arg data} with - {.val {NA}} or {.val {NaN}} values in {.val {c(by, variables)}} column{?s}.")) - data <- data[!rows_with_na, ] - } - - # remove missing by variables from `denominator` - if (is.data.frame(denominator) && !is_empty(intersect(by, names(denominator)))) { - df_na_nan_denom <- - is.na(denominator[intersect(by, names(denominator))]) | - apply(denominator[intersect(by, names(denominator))], MARGIN = 2, is.nan) - if (any(df_na_nan_denom)) { - rows_with_na_denom <- apply(df_na_nan_denom, MARGIN = 1, any) - cli::cli_inform(c("*" = "Removing {.val {sum(rows_with_na_denom)}} row{?s} from {.arg denominator} with - {.val {NA}} or {.val {NaN}} values in {.val {intersect(by, names(denominator))}} column{?s}.")) - denominator <- denominator[!rows_with_na_denom, ] + vec <- cli::cli_vec( + lvls, + style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ", "vec-trunc" = 3) + ) + if (!quiet) cli::cli_inform("{.var {v}}: {.val {vec}}") } } - # sort data ------------------------------------------------------------------ - data <- dplyr::arrange(data, dplyr::pick(all_of(c(id, by, variables)))) - - # print denom columns if not 100% clear which are used - if (!is_empty(id) && is.data.frame(denominator)) { - denom_cols <- intersect(by, names(denominator)) - if (!setequal(by, denom_cols)) { - msg <- - ifelse( - is_empty(denom_cols), - "Denominator set by number of rows in {.arg denominator} data frame.", - "Denominator set by {.val {denom_cols}} column{?s} in {.arg denominator} data frame." - ) - cli::cli_inform(c("i" = msg)) + lst_results <- lapply( + variables, + function(x) { + ard_categorical( + data = data |> + cards:::arrange_using_order(c(id, by, x)) |> + dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator))))), + variables = all_of(x), + by = all_of(by), + statistic = statistic, + denominator = denominator, + fmt_fn = fmt_fn, + stat_label = stat_label + ) |> + list() } - } - - lst_results <- list() - for (var in variables) { - lst_results <- - lst_results |> - append( - ard_categorical( - data = data |> - dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator))))), - variables = all_of(var), - by = all_of(by), - statistic = statistic, - denominator = denominator, - fmt_fn = fmt_fn, - stat_label = stat_label - ) |> - list() - ) - - lst_results[[length(lst_results)]] <- lst_results[[length(lst_results)]] |> - dplyr::mutate(variable_level = as.list(as.character(unlist(.data$variable_level)))) - } + ) # combine results ------------------------------------------------------------ result <- lst_results |> diff --git a/man/ard_categorical_max.Rd b/man/ard_categorical_max.Rd index 213418b6..933ff26e 100644 --- a/man/ard_categorical_max.Rd +++ b/man/ard_categorical_max.Rd @@ -77,6 +77,7 @@ ard_categorical_max( variables = c(AESER, AESEV), id = USUBJID, by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), + quiet = FALSE ) } diff --git a/tests/testthat/_snaps/ard_categorical_max.md b/tests/testthat/_snaps/ard_categorical_max.md index 872ccb8c..2b907493 100644 --- a/tests/testthat/_snaps/ard_categorical_max.md +++ b/tests/testthat/_snaps/ard_categorical_max.md @@ -87,7 +87,7 @@ Code ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), quiet = FALSE) Message - The `AESEV` variable is a character vector. It has been converted to a variable with the following ordered levels: "MILD" < "MODERATE" < "SEVERE". + `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 27 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat @@ -143,8 +143,6 @@ Code ard_categorical_max(dplyr::mutate(cards::ADAE, AESOC = factor(AESOC, levels = character( 0))), variables = AESOC, id = USUBJID, by = TRTA) - Message - * Removing 1191 rows from `data` with NA or NaN values in "TRTA" and "AESOC" columns. Condition Error in `ard_categorical_max()`: ! Factors with empty "levels" attribute are not allowed, which was identified in column "AESOC". diff --git a/tests/testthat/test-ard_categorical_max.R b/tests/testthat/test-ard_categorical_max.R index 4497db76..aadc67d4 100644 --- a/tests/testthat/test-ard_categorical_max.R +++ b/tests/testthat/test-ard_categorical_max.R @@ -90,13 +90,16 @@ test_that("ard_categorical_max(quiet) works", { test_that("ard_categorical_max() works with pre-ordered factor variables", { withr::local_options(list(width = 200)) - # pre-ordered factor variable + # ordered factor variable adae <- cards::ADAE |> dplyr::mutate(AESEV = factor(cards::ADAE$AESEV, ordered = TRUE)) + # unordered factor variable + adae_unord <- cards::ADAE |> + dplyr::mutate(AESEV = factor(cards::ADAE$AESEV, ordered = FALSE)) expect_silent( res <- ard_categorical_max( - cards::ADAE, + adae_unord, variables = AESEV, id = USUBJID, by = TRTA, @@ -108,6 +111,7 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { expect_equal( res |> + dplyr::mutate(variable_level = as.character(unlist(variable_level))) |> dplyr::filter( group1_level == "Placebo", variable_level == "MODERATE", @@ -127,7 +131,7 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { ) res_unord <- ard_categorical_max( - cards::ADAE, + adae_unord, variables = AESEV, id = USUBJID, by = TRTA, @@ -142,7 +146,7 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) - expect_equal(res, res2) + expect_equal(res, res2, ignore_attr = "class") # multiple variables expect_silent( From 367098adcc7bb8be19bc42c76b6d73c706e2fa0c Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 13 Jan 2025 19:58:34 -0500 Subject: [PATCH 11/14] Updates after review --- R/ard_categorical_max.R | 37 ++++++----- man/ard_categorical_max.Rd | 9 +-- tests/testthat/_snaps/ard_categorical_max.md | 65 +++++++++++++++++--- tests/testthat/test-ard_categorical_max.R | 27 +++++++- 4 files changed, 102 insertions(+), 36 deletions(-) diff --git a/R/ard_categorical_max.R b/R/ard_categorical_max.R index 9e52c790..a3ebf83b 100644 --- a/R/ard_categorical_max.R +++ b/R/ard_categorical_max.R @@ -12,10 +12,7 @@ #' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' Argument used to subset `data` to identify rows in `data` to calculate categorical variable level occurrence rates. #' @param denominator (`data.frame`, `integer`)\cr -#' Used to define the denominator and enhance the output. -#' The argument is optional. If not specified, `data` will be used as `denominator`. -#' - the univariate tabulations of the `by` variables are calculated with `denominator` when a data frame is passed, -#' e.g. tabulation of the treatment assignment counts that may appear in the header of a table. +#' Used to define the denominator and enhance the output. Defaults to `data`. #' @param quiet (scalar `logical`)\cr #' Logical indicating whether to suppress additional messaging. Default is `FALSE`. #' @@ -41,7 +38,7 @@ ard_categorical_max <- function(data, id, by = dplyr::group_vars(data), statistic = everything() ~ c("n", "p", "N"), - denominator = NULL, + denominator = data, fmt_fn = NULL, stat_label = everything() ~ cards::default_stat_labels(), quiet = TRUE, @@ -62,7 +59,6 @@ ard_categorical_max <- function(data, call = get_cli_abort_call() ) } - if (is_empty(denominator)) denominator <- data # check the id argument is not empty if (is_empty(id)) { @@ -74,16 +70,14 @@ ard_categorical_max <- function(data, return(dplyr::tibble() |> cards::as_card()) } - # print default order of character variable levels --------------------------- + # print default order of variable levels ------------------------------------- for (v in variables) { - if (is.character(data[[v]])) { - lvls <- .unique_and_sorted(data[[v]]) - vec <- cli::cli_vec( - lvls, - style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ", "vec-trunc" = 3) - ) - if (!quiet) cli::cli_inform("{.var {v}}: {.val {vec}}") - } + lvls <- .unique_and_sorted(data[[v]]) + vec <- cli::cli_vec( + lvls, + style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ", "vec-trunc" = 3) + ) + if (!quiet) cli::cli_inform("{.var {v}}: {.val {vec}}") } lst_results <- lapply( @@ -91,16 +85,15 @@ ard_categorical_max <- function(data, function(x) { ard_categorical( data = data |> - cards:::arrange_using_order(c(id, by, x)) |> - dplyr::slice_tail(n = 1L, by = all_of(c(id, intersect(by, names(denominator))))), + arrange_using_order(c(id, by, x)) |> + dplyr::slice_tail(n = 1L, by = all_of(c(id, by))), variables = all_of(x), by = all_of(by), statistic = statistic, denominator = denominator, fmt_fn = fmt_fn, stat_label = stat_label - ) |> - list() + ) } ) @@ -114,3 +107,9 @@ ard_categorical_max <- function(data, # return final result -------------------------------------------------------- result } + +# internal function copied from cards +# like `dplyr::arrange()`, but uses base R's `order()` to keep consistency in some edge cases +arrange_using_order <- function(data, columns) { + inject(data[with(data, order(!!!syms(columns))), ]) +} diff --git a/man/ard_categorical_max.Rd b/man/ard_categorical_max.Rd index 933ff26e..302263fd 100644 --- a/man/ard_categorical_max.Rd +++ b/man/ard_categorical_max.Rd @@ -10,7 +10,7 @@ ard_categorical_max( id, by = dplyr::group_vars(data), statistic = everything() ~ c("n", "p", "N"), - denominator = NULL, + denominator = data, fmt_fn = NULL, stat_label = everything() ~ cards::default_stat_labels(), quiet = TRUE, @@ -37,12 +37,7 @@ or a single formula where the list element one or more of \code{c("n", "N", "p" (or the RHS of a formula).} \item{denominator}{(\code{data.frame}, \code{integer})\cr -Used to define the denominator and enhance the output. -The argument is optional. If not specified, \code{data} will be used as \code{denominator}. -\itemize{ -\item the univariate tabulations of the \code{by} variables are calculated with \code{denominator} when a data frame is passed, -e.g. tabulation of the treatment assignment counts that may appear in the header of a table. -}} +Used to define the denominator and enhance the output. Defaults to \code{data}.} \item{fmt_fn}{(\code{\link[cards:syntax]{formula-list-selector}})\cr a named list, a list of formulas, diff --git a/tests/testthat/_snaps/ard_categorical_max.md b/tests/testthat/_snaps/ard_categorical_max.md index 2b907493..a09bb5d2 100644 --- a/tests/testthat/_snaps/ard_categorical_max.md +++ b/tests/testthat/_snaps/ard_categorical_max.md @@ -82,30 +82,77 @@ Message i 4 more variables: context, fmt_fn, warning, error -# ard_categorical_max(quiet) works +# ard_categorical_max(denominator) works Code - ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), quiet = FALSE) + ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA) Message - `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 27 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo AESEV MILD n n 36 - 2 TRTA Placebo AESEV MILD N N 86 - 3 TRTA Placebo AESEV MILD p % 0.419 + 2 TRTA Placebo AESEV MILD N N 301 + 3 TRTA Placebo AESEV MILD p % 0.12 4 TRTA Placebo AESEV MODERATE n n 26 - 5 TRTA Placebo AESEV MODERATE N N 86 - 6 TRTA Placebo AESEV MODERATE p % 0.302 + 5 TRTA Placebo AESEV MODERATE N N 301 + 6 TRTA Placebo AESEV MODERATE p % 0.086 7 TRTA Placebo AESEV SEVERE n n 7 - 8 TRTA Placebo AESEV SEVERE N N 86 - 9 TRTA Placebo AESEV SEVERE p % 0.081 + 8 TRTA Placebo AESEV SEVERE N N 301 + 9 TRTA Placebo AESEV SEVERE p % 0.023 10 TRTA Xanomeli… AESEV MILD n n 22 Message i 17 more rows i Use `print(n = ...)` to see more rows i 4 more variables: context, fmt_fn, warning, error +--- + + Code + ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = 100) + Message + {cards} data frame: 27 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AESEV MILD n n 36 + 2 TRTA Placebo AESEV MILD N N 100 + 3 TRTA Placebo AESEV MILD p % 0.36 + 4 TRTA Placebo AESEV MODERATE n n 26 + 5 TRTA Placebo AESEV MODERATE N N 100 + 6 TRTA Placebo AESEV MODERATE p % 0.26 + 7 TRTA Placebo AESEV SEVERE n n 7 + 8 TRTA Placebo AESEV SEVERE N N 100 + 9 TRTA Placebo AESEV SEVERE p % 0.07 + 10 TRTA Xanomeli… AESEV MILD n n 22 + Message + i 17 more rows + i Use `print(n = ...)` to see more rows + i 4 more variables: context, fmt_fn, warning, error + +# ard_categorical_max(quiet) works + + Code + ard_categorical_max(cards::ADAE, variables = c(AESER, AESEV), id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), quiet = FALSE) + Message + `AESER`: "N" < "Y" + `AESEV`: "MILD" < "MODERATE" < "SEVERE" + {cards} data frame: 45 x 11 + Output + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AESER N n n 69 + 2 TRTA Placebo AESER N N N 86 + 3 TRTA Placebo AESER N p % 0.802 + 4 TRTA Placebo AESER Y n n 0 + 5 TRTA Placebo AESER Y N N 86 + 6 TRTA Placebo AESER Y p % 0 + 7 TRTA Xanomeli… AESER N n n 77 + 8 TRTA Xanomeli… AESER N N N 84 + 9 TRTA Xanomeli… AESER N p % 0.917 + 10 TRTA Xanomeli… AESER Y n n 2 + Message + i 35 more rows + i Use `print(n = ...)` to see more rows + i 4 more variables: context, fmt_fn, warning, error + # ard_categorical_max() works with pre-ordered factor variables Code diff --git a/tests/testthat/test-ard_categorical_max.R b/tests/testthat/test-ard_categorical_max.R index aadc67d4..c7cefbe4 100644 --- a/tests/testthat/test-ard_categorical_max.R +++ b/tests/testthat/test-ard_categorical_max.R @@ -72,14 +72,39 @@ test_that("ard_categorical_max(statistic) works", { ) }) -test_that("ard_categorical_max(quiet) works", { +test_that("ard_categorical_max(denominator) works", { withr::local_options(list(width = 200)) + # default denominator expect_snapshot( ard_categorical_max( cards::ADAE, variables = AESEV, id = USUBJID, + by = TRTA + ) + ) + + # numeric denominator + expect_snapshot( + ard_categorical_max( + cards::ADAE, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = 100 + ) + ) +}) + +test_that("ard_categorical_max(quiet) works", { + withr::local_options(list(width = 200)) + + expect_snapshot( + ard_categorical_max( + cards::ADAE, + variables = c(AESER, AESEV), + id = USUBJID, by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), quiet = FALSE From 8f9b8cf16ef43a156fa883efb0cf5ba75095ae89 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 15 Jan 2025 15:45:03 -0500 Subject: [PATCH 12/14] Updates after review --- R/ard_categorical_max.R | 19 ++---- man/ard_categorical_max.Rd | 11 ++-- tests/testthat/_snaps/ard_categorical_max.md | 67 +++++++------------- tests/testthat/test-ard_categorical_max.R | 50 ++++++++------- 4 files changed, 62 insertions(+), 85 deletions(-) diff --git a/R/ard_categorical_max.R b/R/ard_categorical_max.R index a3ebf83b..985b70fb 100644 --- a/R/ard_categorical_max.R +++ b/R/ard_categorical_max.R @@ -12,7 +12,9 @@ #' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' Argument used to subset `data` to identify rows in `data` to calculate categorical variable level occurrence rates. #' @param denominator (`data.frame`, `integer`)\cr -#' Used to define the denominator and enhance the output. Defaults to `data`. +#' An optional argument to change the denominator used for `"N"` and `"p"` statistic calculations. +#' Defaults to `NULL`, in which case `dplyr::distinct(data, dplyr::pick(all_of(c(id, by))))` is used for these +#' calculations. See [cards::ard_categorical()] for more details on specifying denominators. #' @param quiet (scalar `logical`)\cr #' Logical indicating whether to suppress additional messaging. Default is `FALSE`. #' @@ -26,8 +28,7 @@ #' variables = c(AESER, AESEV), #' id = USUBJID, #' by = TRTA, -#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), -#' quiet = FALSE +#' denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) #' ) NULL @@ -38,10 +39,10 @@ ard_categorical_max <- function(data, id, by = dplyr::group_vars(data), statistic = everything() ~ c("n", "p", "N"), - denominator = data, + denominator = NULL, fmt_fn = NULL, stat_label = everything() ~ cards::default_stat_labels(), - quiet = TRUE, + quiet = FALSE, ...) { set_cli_abort_call() @@ -52,14 +53,6 @@ ard_categorical_max <- function(data, cards::process_selectors(data, variables = {{ variables }}, id = {{ id }}, by = {{ by }}) data <- dplyr::ungroup(data) - # denominator must a data frame, or integer - if (!is_empty(denominator) && !is.data.frame(denominator) && !is_integerish(denominator)) { - cli::cli_abort( - "The {.arg denominator} argument must be a {.cls data.frame} or an {.cls integer}, not {.obj_type_friendly {denominator}}.", - call = get_cli_abort_call() - ) - } - # check the id argument is not empty if (is_empty(id)) { cli::cli_abort("Argument {.arg id} cannot be empty.", call = get_cli_abort_call()) diff --git a/man/ard_categorical_max.Rd b/man/ard_categorical_max.Rd index 302263fd..25bb6a1a 100644 --- a/man/ard_categorical_max.Rd +++ b/man/ard_categorical_max.Rd @@ -10,10 +10,10 @@ ard_categorical_max( id, by = dplyr::group_vars(data), statistic = everything() ~ c("n", "p", "N"), - denominator = data, + denominator = NULL, fmt_fn = NULL, stat_label = everything() ~ cards::default_stat_labels(), - quiet = TRUE, + quiet = FALSE, ... ) } @@ -37,7 +37,9 @@ or a single formula where the list element one or more of \code{c("n", "N", "p" (or the RHS of a formula).} \item{denominator}{(\code{data.frame}, \code{integer})\cr -Used to define the denominator and enhance the output. Defaults to \code{data}.} +An optional argument to change the denominator used for \code{"N"} and \code{"p"} statistic calculations. +Defaults to \code{NULL}, in which case \code{dplyr::distinct(data, dplyr::pick(all_of(c(id, by))))} is used for these +calculations. See \code{\link[cards:ard_categorical]{cards::ard_categorical()}} for more details on specifying denominators.} \item{fmt_fn}{(\code{\link[cards:syntax]{formula-list-selector}})\cr a named list, a list of formulas, @@ -72,7 +74,6 @@ ard_categorical_max( variables = c(AESER, AESEV), id = USUBJID, by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), - quiet = FALSE + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) ) } diff --git a/tests/testthat/_snaps/ard_categorical_max.md b/tests/testthat/_snaps/ard_categorical_max.md index a09bb5d2..51937e20 100644 --- a/tests/testthat/_snaps/ard_categorical_max.md +++ b/tests/testthat/_snaps/ard_categorical_max.md @@ -7,25 +7,25 @@ Output group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error 1 TRTA Placebo AESEV MILD categori… n n 36 0 - 2 TRTA Placebo AESEV MILD categori… N N 301 0 - 3 TRTA Placebo AESEV MILD categori… p % 0.12 + 2 TRTA Placebo AESEV MILD categori… N N 69 0 + 3 TRTA Placebo AESEV MILD categori… p % 0.522 4 TRTA Placebo AESEV MODERATE categori… n n 26 0 - 5 TRTA Placebo AESEV MODERATE categori… N N 301 0 - 6 TRTA Placebo AESEV MODERATE categori… p % 0.086 + 5 TRTA Placebo AESEV MODERATE categori… N N 69 0 + 6 TRTA Placebo AESEV MODERATE categori… p % 0.377 7 TRTA Placebo AESEV SEVERE categori… n n 7 0 - 8 TRTA Placebo AESEV SEVERE categori… N N 301 0 - 9 TRTA Placebo AESEV SEVERE categori… p % 0.023 + 8 TRTA Placebo AESEV SEVERE categori… N N 69 0 + 9 TRTA Placebo AESEV SEVERE categori… p % 0.101 10 TRTA Xanomeli… AESEV MILD categori… n n 22 0 - 11 TRTA Xanomeli… AESEV MILD categori… N N 455 0 - 12 TRTA Xanomeli… AESEV MILD categori… p % 0.048 + 11 TRTA Xanomeli… AESEV MILD categori… N N 79 0 + 12 TRTA Xanomeli… AESEV MILD categori… p % 0.278 13 TRTA Xanomeli… AESEV MODERATE categori… n n 49 0 - 14 TRTA Xanomeli… AESEV MODERATE categori… N N 455 0 - 15 TRTA Xanomeli… AESEV MODERATE categori… p % 0.108 + 14 TRTA Xanomeli… AESEV MODERATE categori… N N 79 0 + 15 TRTA Xanomeli… AESEV MODERATE categori… p % 0.62 16 TRTA Xanomeli… AESEV SEVERE categori… n n 8 0 - 17 TRTA Xanomeli… AESEV SEVERE categori… N N 455 0 - 18 TRTA Xanomeli… AESEV SEVERE categori… p % 0.018 + 17 TRTA Xanomeli… AESEV SEVERE categori… N N 79 0 + 18 TRTA Xanomeli… AESEV SEVERE categori… p % 0.101 19 TRTA Xanomeli… AESEV MILD categori… n n 19 0 - 20 TRTA Xanomeli… AESEV MILD categori… N N 435 0 + 20 TRTA Xanomeli… AESEV MILD categori… N N 77 0 Message i 7 more rows i Use `print(n = ...)` to see more rows @@ -35,6 +35,7 @@ Code print(ard_categorical_max(dplyr::group_by(cards::ADAE, TRTA), variables = AESEV, id = USUBJID, denominator = dplyr::rename(cards::ADSL, TRTA = ARM)), n = 20, columns = "all") Message + `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 27 x 11 Output group1 group1_level variable variable_level context stat_name stat_label stat fmt_fn warning error @@ -67,6 +68,7 @@ Code ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), statistic = ~"n") Message + `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 9 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat @@ -87,18 +89,19 @@ Code ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA) Message + `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 27 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo AESEV MILD n n 36 - 2 TRTA Placebo AESEV MILD N N 301 - 3 TRTA Placebo AESEV MILD p % 0.12 + 2 TRTA Placebo AESEV MILD N N 69 + 3 TRTA Placebo AESEV MILD p % 0.522 4 TRTA Placebo AESEV MODERATE n n 26 - 5 TRTA Placebo AESEV MODERATE N N 301 - 6 TRTA Placebo AESEV MODERATE p % 0.086 + 5 TRTA Placebo AESEV MODERATE N N 69 + 6 TRTA Placebo AESEV MODERATE p % 0.377 7 TRTA Placebo AESEV SEVERE n n 7 - 8 TRTA Placebo AESEV SEVERE N N 301 - 9 TRTA Placebo AESEV SEVERE p % 0.023 + 8 TRTA Placebo AESEV SEVERE N N 69 + 9 TRTA Placebo AESEV SEVERE p % 0.101 10 TRTA Xanomeli… AESEV MILD n n 22 Message i 17 more rows @@ -110,6 +113,7 @@ Code ard_categorical_max(cards::ADAE, variables = AESEV, id = USUBJID, by = TRTA, denominator = 100) Message + `AESEV`: "MILD" < "MODERATE" < "SEVERE" {cards} data frame: 27 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat @@ -128,31 +132,6 @@ i Use `print(n = ...)` to see more rows i 4 more variables: context, fmt_fn, warning, error -# ard_categorical_max(quiet) works - - Code - ard_categorical_max(cards::ADAE, variables = c(AESER, AESEV), id = USUBJID, by = TRTA, denominator = dplyr::rename(cards::ADSL, TRTA = ARM), quiet = FALSE) - Message - `AESER`: "N" < "Y" - `AESEV`: "MILD" < "MODERATE" < "SEVERE" - {cards} data frame: 45 x 11 - Output - group1 group1_level variable variable_level stat_name stat_label stat - 1 TRTA Placebo AESER N n n 69 - 2 TRTA Placebo AESER N N N 86 - 3 TRTA Placebo AESER N p % 0.802 - 4 TRTA Placebo AESER Y n n 0 - 5 TRTA Placebo AESER Y N N 86 - 6 TRTA Placebo AESER Y p % 0 - 7 TRTA Xanomeli… AESER N n n 77 - 8 TRTA Xanomeli… AESER N N N 84 - 9 TRTA Xanomeli… AESER N p % 0.917 - 10 TRTA Xanomeli… AESER Y n n 2 - Message - i 35 more rows - i Use `print(n = ...)` to see more rows - i 4 more variables: context, fmt_fn, warning, error - # ard_categorical_max() works with pre-ordered factor variables Code diff --git a/tests/testthat/test-ard_categorical_max.R b/tests/testthat/test-ard_categorical_max.R index c7cefbe4..075e3455 100644 --- a/tests/testthat/test-ard_categorical_max.R +++ b/tests/testthat/test-ard_categorical_max.R @@ -1,7 +1,7 @@ test_that("ard_categorical_max() works with default settings", { withr::local_options(list(width = 200)) - expect_silent( + expect_message( res <- ard_categorical_max( cards::ADAE, variables = AESEV, @@ -42,14 +42,14 @@ test_that("ard_categorical_max() works with default settings", { ) # with multiple variables - expect_silent( + expect_message(expect_message( res2 <- ard_categorical_max( cards::ADAE, variables = c(AESEV, AESER), id = USUBJID, by = TRTA ) - ) + )) expect_equal(unique(res2$variable), c("AESEV", "AESER")) expect_equal( res, @@ -100,14 +100,14 @@ test_that("ard_categorical_max(denominator) works", { test_that("ard_categorical_max(quiet) works", { withr::local_options(list(width = 200)) - expect_snapshot( + expect_silent( ard_categorical_max( cards::ADAE, variables = c(AESER, AESEV), id = USUBJID, by = TRTA, denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), - quiet = FALSE + quiet = TRUE ) ) }) @@ -122,7 +122,7 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { adae_unord <- cards::ADAE |> dplyr::mutate(AESEV = factor(cards::ADAE$AESEV, ordered = FALSE)) - expect_silent( + expect_message( res <- ard_categorical_max( adae_unord, variables = AESEV, @@ -155,26 +155,30 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { ) ) - res_unord <- ard_categorical_max( - adae_unord, - variables = AESEV, - id = USUBJID, - by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + expect_message( + res_unord <- ard_categorical_max( + adae_unord, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + ) ) expect_equal(res$stat[[1]], res_unord$stat[[1]]) - res2 <- ard_categorical_max( - adae, - variables = AESEV, - id = USUBJID, - by = TRTA, - denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + expect_message( + res2 <- ard_categorical_max( + adae, + variables = AESEV, + id = USUBJID, + by = TRTA, + denominator = cards::ADSL |> dplyr::rename(TRTA = ARM) + ) ) expect_equal(res, res2, ignore_attr = "class") # multiple variables - expect_silent( + expect_message(expect_message( res3 <- ard_categorical_max( adae, variables = c(SEX, AESEV), @@ -183,11 +187,11 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), ordered = c(FALSE, TRUE) ) - ) + )) expect_equal(res, res3[-c(1:18), ]) # named vector - expect_silent( + expect_message(expect_message( res4 <- ard_categorical_max( adae, variables = c(SEX, AESEV), @@ -196,7 +200,7 @@ test_that("ard_categorical_max() works with pre-ordered factor variables", { denominator = cards::ADSL |> dplyr::rename(TRTA = ARM), ordered = c(AESEV = TRUE, SEX = FALSE) ) - ) + )) expect_equal(res3, res4) }) @@ -238,7 +242,7 @@ test_that("ard_categorical_max() works without any variables", { }) test_that("ard_categorical_max() follows ard structure", { - expect_silent( + expect_message( ard_categorical_max( cards::ADAE, variables = AESOC, From c4f5ec096b3f5470e1be15f096e9ab35f59e2a1d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 15 Jan 2025 15:45:18 -0500 Subject: [PATCH 13/14] Only print message if no error occurs --- R/ard_categorical_max.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/R/ard_categorical_max.R b/R/ard_categorical_max.R index 985b70fb..659386bd 100644 --- a/R/ard_categorical_max.R +++ b/R/ard_categorical_max.R @@ -63,16 +63,6 @@ ard_categorical_max <- function(data, return(dplyr::tibble() |> cards::as_card()) } - # print default order of variable levels ------------------------------------- - for (v in variables) { - lvls <- .unique_and_sorted(data[[v]]) - vec <- cli::cli_vec( - lvls, - style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ", "vec-trunc" = 3) - ) - if (!quiet) cli::cli_inform("{.var {v}}: {.val {vec}}") - } - lst_results <- lapply( variables, function(x) { @@ -90,6 +80,16 @@ ard_categorical_max <- function(data, } ) + # print default order of variable levels ------------------------------------- + for (v in variables) { + lvls <- .unique_and_sorted(data[[v]]) + vec <- cli::cli_vec( + lvls, + style = list("vec-sep" = " < ", "vec-sep2" = " < ", "vec-last" = " < ", "vec-trunc" = 3) + ) + if (!quiet) cli::cli_inform("{.var {v}}: {.val {vec}}") + } + # combine results ------------------------------------------------------------ result <- lst_results |> dplyr::bind_rows() |> From 61e16b6df8b032f7306fe126ba2917f36a7f0521 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 15 Jan 2025 16:04:43 -0500 Subject: [PATCH 14/14] Update NEWS --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 928024a0..a59c0f33 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ * Fixed a bug in `ard_survival_survfit()` causing an error when "=" character is present in stratification variable level labels. (#252) +* Added function `ard_categorical_max()` to calculate categorical occurrence rates by maximum level per unique ID. (#240) + # cardx 0.2.2 * Added a `data.frame` method to `ard_survival_survfit()`.