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 1/6] 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 2/6] 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 3/6] 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 4/6] 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 5/6] 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 6/6] 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(