Adds denom argument to count s_* functions

NEWS.md

@@ -1,5 +1,9 @@
 # tern 0.9.6.9005
 
+### Enhancements
+* Added the `denom` parameter to `s_count_cumulative()`, `s_count_missed_doses()`, and `s_count_occurrences_by_grade()`.
+* Added `"N_row"` as an optional input to `denom` in `s_count_occurrences()`.
+
 ### Bug Fixes
 * Fixed bug in `a_summary()` causing non-unique `row_name` values to occur when multiple statistics are selected for count variables.
 

R/analyze_variables.R

@@ -236,11 +236,6 @@ s_summary.numeric <- function(x,
 
 #' @describeIn analyze_variables Method for `factor` class.
 #'
-#' @param denom (`string`)\cr choice of denominator for factor proportions. Options are:
-#'   * `n`: number of values in this row and column intersection.
-#'   * `N_row`: total number of values in this row across columns.
-#'   * `N_col`: total number of values in this column across rows.
-#'
 #' @return
 #'   * If `x` is of class `factor` or converted from `character`, returns a `list` with named `numeric` items:
 #'     * `n`: The [length()] of `x`.
@@ -281,12 +276,11 @@ s_summary.numeric <- function(x,
 #' @export
 s_summary.factor <- function(x,
                              na.rm = TRUE, # nolint
-                             denom = c("n", "N_row", "N_col"),
+                             denom = c("n", "N_col", "N_row"),
                              .N_row, # nolint
                              .N_col, # nolint
                              ...) {
   assert_valid_factor(x)
-  denom <- match.arg(denom)
 
   if (na.rm) {
     x <- x[!is.na(x)] %>% fct_discard("<Missing>")
@@ -299,20 +293,23 @@ s_summary.factor <- function(x,
   y$n <- length(x)
 
   y$count <- as.list(table(x, useNA = "ifany"))
-  dn <- switch(denom,
-    n = length(x),
-    N_row = .N_row,
-    N_col = .N_col
-  )
+
+  denom <- match.arg(denom) %>%
+    switch(
+      n = length(x),
+      N_row = .N_row,
+      N_col = .N_col
+    )
+
   y$count_fraction <- lapply(
     y$count,
     function(x) {
-      c(x, ifelse(dn > 0, x / dn, 0))
+      c(x, ifelse(denom > 0, x / denom, 0))
     }
   )
   y$fraction <- lapply(
     y$count,
-    function(count) c("num" = count, "denom" = dn)
+    function(count) c("num" = count, "denom" = denom)
   )
 
   y$n_blq <- sum(grepl("BLQ|LTR|<[1-9]|<PCLLOQ", x))
@@ -344,7 +341,7 @@ s_summary.factor <- function(x,
 #' @export
 s_summary.character <- function(x,
                                 na.rm = TRUE, # nolint
-                                denom = c("n", "N_row", "N_col"),
+                                denom = c("n", "N_col", "N_row"),
                                 .N_row, # nolint
                                 .N_col, # nolint
                                 .var,
@@ -368,11 +365,6 @@ s_summary.character <- function(x,
 
 #' @describeIn analyze_variables Method for `logical` class.
 #'
-#' @param denom (`string`)\cr choice of denominator for proportion. Options are:
-#'   * `n`: number of values in this row and column intersection.
-#'   * `N_row`: total number of values in this row across columns.
-#'   * `N_col`: total number of values in this column across rows.
-#'
 #' @return
 #'   * If `x` is of class `logical`, returns a `list` with named `numeric` items:
 #'     * `n`: The [length()] of `x` (possibly after removing `NA`s).
@@ -404,22 +396,22 @@ s_summary.character <- function(x,
 #' @export
 s_summary.logical <- function(x,
                               na.rm = TRUE, # nolint
-                              denom = c("n", "N_row", "N_col"),
+                              denom = c("n", "N_col", "N_row"),
                               .N_row, # nolint
                               .N_col, # nolint
                               ...) {
-  denom <- match.arg(denom)
   if (na.rm) x <- x[!is.na(x)]
   y <- list()
   y$n <- length(x)
   count <- sum(x, na.rm = TRUE)
-  dn <- switch(denom,
-    n = length(x),
-    N_row = .N_row,
-    N_col = .N_col
-  )
+  denom <- match.arg(denom) %>%
+    switch(
+      n = length(x),
+      N_row = .N_row,
+      N_col = .N_col
+    )
   y$count <- count
-  y$count_fraction <- c(count, ifelse(dn > 0, count / dn, 0))
+  y$count_fraction <- c(count, ifelse(denom > 0, count / denom, 0))
   y$n_blq <- 0L
   y
 }

R/argument_convention.R

@@ -30,6 +30,10 @@
 #' @param col_by (`factor`)\cr defining column groups.
 #' @param conf_level (`proportion`)\cr confidence level of the interval.
 #' @param data (`data.frame`)\cr the dataset containing the variables to summarize.
+#' @param denom (`string`)\cr choice of denominator for proportion. Options are:
+#'   * `n`: number of values in this row and column intersection.
+#'   * `N_row`: total number of values in this row across columns.
+#'   * `N_col`: total number of values in this column across rows.
 #' @param df (`data.frame`)\cr data set containing all analysis variables.
 #' @param groups_lists (named `list` of `list`)\cr optionally contains for each `subgroups` variable a
 #'   list, which specifies the new group levels via the names and the

R/count_cumulative.R

@@ -77,7 +77,10 @@ h_count_cumulative <- function(x,
     length(x[is_keep & x > threshold])
   }
 
-  result <- c(count = count, fraction = count / .N_col)
+  result <- c(
+    count = count,
+    fraction = if (count == 0 && .N_col == 0) 0 else count / .N_col
+  )
   result
 }
 
@@ -111,11 +114,20 @@ s_count_cumulative <- function(x,
                                lower_tail = TRUE,
                                include_eq = TRUE,
                                .N_col, # nolint
+                               .N_row, # nolint
+                               denom = c("N_col", "n", "N_row"),
                                ...) {
   checkmate::assert_numeric(thresholds, min.len = 1, any.missing = FALSE)
 
+  denom <- match.arg(denom) %>%
+    switch(
+      n = length(x),
+      N_row = .N_row,
+      N_col = .N_col
+    )
+
   count_fraction_list <- Map(function(thres) {
-    result <- h_count_cumulative(x, thres, lower_tail, include_eq, .N_col = .N_col, ...)
+    result <- h_count_cumulative(x, thres, lower_tail, include_eq, .N_col = denom, ...)
     label <- d_count_cumulative(thres, lower_tail, include_eq)
     formatters::with_label(result, label)
   }, thresholds)

R/count_missed_doses.R

@@ -57,13 +57,17 @@ d_count_missed_doses <- function(thresholds) {
 #' @keywords internal
 s_count_missed_doses <- function(x,
                                  thresholds,
-                                 .N_col) { # nolint
+                                 .N_col, # nolint
+                                 .N_row, # nolint
+                                 denom = c("N_col", "n", "N_row")) {
   stat <- s_count_cumulative(
     x = x,
     thresholds = thresholds,
     lower_tail = FALSE,
     include_eq = TRUE,
-    .N_col = .N_col
+    .N_col = .N_col,
+    .N_row = .N_row,
+    denom = denom
   )
   labels <- d_count_missed_doses(thresholds)
   for (i in seq_along(stat$count_fraction)) {

R/count_occurrences.R

@@ -50,9 +50,10 @@ NULL
 #' @describeIn count_occurrences Statistics function which counts number of patients that report an
 #' occurrence.
 #'
-#' @param denom (`string`)\cr choice of denominator for patient proportions. Can be:
-#'   - `N_col`: total number of patients in this column across rows
-#'   - `n`: number of patients with any occurrences
+#' @param denom (`string`)\cr choice of denominator for proportion. Options are:
+#'   * `N_col`: total number of patients in this column across rows.
+#'   * `n`: number of patients with any occurrences.
+#'   * `N_row`: total number of patients in this row across columns.
 #'
 #' @return
 #' * `s_count_occurrences()` returns a list with:
@@ -65,15 +66,17 @@ NULL
 #' s_count_occurrences(
 #'   df,
 #'   .N_col = 4L,
+#'   .N_row = 4L,
 #'   .df_row = df,
 #'   .var = "MHDECOD",
 #'   id = "USUBJID"
 #' )
 #'
 #' @export
 s_count_occurrences <- function(df,
-                                denom = c("N_col", "n"),
+                                denom = c("N_col", "n", "N_row"),
                                 .N_col, # nolint
+                                .N_row, # nolint
                                 .df_row,
                                 drop = TRUE,
                                 .var = "MHDECOD",
@@ -83,7 +86,6 @@ s_count_occurrences <- function(df,
   checkmate::assert_count(.N_col)
   checkmate::assert_multi_class(df[[.var]], classes = c("factor", "character"))
   checkmate::assert_multi_class(df[[id]], classes = c("factor", "character"))
-  denom <- match.arg(denom)
 
   occurrences <- if (drop) {
     # Note that we don't try to preserve original level order here since a) that would required
@@ -100,10 +102,12 @@ s_count_occurrences <- function(df,
     df[[.var]]
   }
   ids <- factor(df[[id]])
-  dn <- switch(denom,
-    n = nlevels(ids),
-    N_col = .N_col
-  )
+  denom <- match.arg(denom) %>%
+    switch(
+      n = nlevels(ids),
+      N_row = .N_row,
+      N_col = .N_col
+    )
   has_occurrence_per_id <- table(occurrences, ids) > 0
   n_ids_per_occurrence <- as.list(rowSums(has_occurrence_per_id))
   list(
@@ -117,12 +121,12 @@ s_count_occurrences <- function(df,
           c(i, i / denom)
         }
       },
-      denom = dn
+      denom = denom
     ),
     fraction = lapply(
       n_ids_per_occurrence,
       function(i, denom) c("num" = i, "denom" = denom),
-      denom = dn
+      denom = denom
     )
   )
 }
@@ -146,9 +150,10 @@ s_count_occurrences <- function(df,
 a_count_occurrences <- function(df,
                                 labelstr = "",
                                 id = "USUBJID",
-                                denom = c("N_col", "n"),
+                                denom = c("N_col", "n", "N_row"),
                                 drop = TRUE,
                                 .N_col, # nolint
+                                .N_row, # nolint
                                 .var = NULL,
                                 .df_row = NULL,
                                 .stats = NULL,
@@ -158,7 +163,7 @@ a_count_occurrences <- function(df,
                                 na_str = default_na_str()) {
   denom <- match.arg(denom)
   x_stats <- s_count_occurrences(
-    df = df, denom = denom, .N_col = .N_col, .df_row = .df_row, drop = drop, .var = .var, id = id
+    df = df, denom = denom, .N_col = .N_col, .N_row = .N_row, .df_row = .df_row, drop = drop, .var = .var, id = id
   )
   if (is.null(unlist(x_stats))) {
     return(NULL)

R/count_occurrences_by_grade.R

@@ -16,6 +16,7 @@
 #' row/column context and operates on the level of the latest row split or the root of the table if no row splits have
 #' occurred.
 #'
+#' @inheritParams count_occurrences
 #' @inheritParams argument_convention
 #' @param grade_groups (named `list` of `character`)\cr list containing groupings of grades.
 #' @param remove_single (`flag`)\cr `TRUE` to not include the elements of one-element grade groups
@@ -148,15 +149,24 @@ h_append_grade_groups <- function(grade_groups, refs, remove_single = TRUE, only
 #' @export
 s_count_occurrences_by_grade <- function(df,
                                          .var,
+                                         .N_row, # nolint
                                          .N_col, # nolint
                                          id = "USUBJID",
                                          grade_groups = list(),
                                          remove_single = TRUE,
                                          only_grade_groups = FALSE,
+                                         denom = c("N_col", "n", "N_row"),
                                          labelstr = "") {
   assert_valid_factor(df[[.var]])
   assert_df_with_variables(df, list(grade = .var, id = id))
 
+  denom <- match.arg(denom) %>%
+    switch(
+      n = nlevels(factor(df[[id]])),
+      N_row = .N_row,
+      N_col = .N_col
+    )
+
   if (nrow(df) < 1) {
     grade_levels <- levels(df[[.var]])
     l_count <- as.list(rep(0, length(grade_levels)))
@@ -200,7 +210,17 @@ s_count_occurrences_by_grade <- function(df,
     l_count <- h_append_grade_groups(grade_groups, l_count, remove_single, only_grade_groups)
   }
 
-  l_count_fraction <- lapply(l_count, function(i, denom) c(i, i / denom), denom = .N_col)
+  l_count_fraction <- lapply(
+    l_count,
+    function(i, denom) {
+      if (i == 0 && denom == 0) {
+        c(0, 0)
+      } else {
+        c(i, i / denom)
+      }
+    },
+    denom = denom
+  )
 
   list(
     count_fraction = l_count_fraction
@@ -214,12 +234,13 @@ s_count_occurrences_by_grade <- function(df,
 #' * `a_count_occurrences_by_grade()` returns the corresponding list with formatted [rtables::CellValue()].
 #'
 #' @examples
-#' #  We need to ungroup `count_fraction` first so that the `rtables` formatting
+#' # We need to ungroup `count_fraction` first so that the `rtables` formatting
 #' # function `format_count_fraction()` can be applied correctly.
 #' afun <- make_afun(a_count_occurrences_by_grade, .ungroup_stats = "count_fraction")
 #' afun(
 #'   df,
 #'   .N_col = 10L,
+#'   .N_row = 10L,
 #'   .var = "AETOXGR",
 #'   id = "USUBJID",
 #'   grade_groups = list("ANY" = levels(df$AETOXGR))

R/count_patients_with_event.R

@@ -64,7 +64,7 @@ s_count_patients_with_event <- function(df,
                                         filters,
                                         .N_col, # nolint
                                         .N_row, # nolint
-                                        denom = c("n", "N_row", "N_col")) {
+                                        denom = c("n", "N_col", "N_row")) {
   col_names <- names(filters)
   filter_values <- filters
 

R/count_patients_with_flags.R

@@ -57,7 +57,7 @@ s_count_patients_with_flags <- function(df,
                                         flag_labels = NULL,
                                         .N_col, # nolint
                                         .N_row, # nolint
-                                        denom = c("n", "N_row", "N_col")) {
+                                        denom = c("n", "N_col", "N_row")) {
   checkmate::assert_character(flag_variables)
   if (!is.null(flag_labels)) {
     checkmate::assert_character(flag_labels, len = length(flag_variables), any.missing = FALSE)

R/count_values.R

@@ -37,7 +37,7 @@ s_count_values <- function(x,
                            na.rm = TRUE, # nolint
                            .N_col, # nolint
                            .N_row, # nolint
-                           denom = c("n", "N_row", "N_col")) {
+                           denom = c("n", "N_col", "N_row")) {
   UseMethod("s_count_values", x)
 }