Fix label and indentation processors (#1379)

NEWS.md

@@ -1,5 +1,8 @@
 # tern 0.9.7.9000
 
+### Bug Fixes
+* Fixed bug in `a_count_patients_with_flags()` preventing select custom label and indentation specification formats from being applied.
+
 # tern 0.9.7
 
 ### Enhancements

R/abnormal.R

@@ -25,7 +25,7 @@
 #'   from numerator and denominator.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("abnormal"))``
+#'   Options are: ``r shQuote(get_stats("abnormal"), type = "sh")``
 #'
 #' @note
 #' * `count_abnormal()` only considers a single variable that contains multiple abnormal levels.

R/abnormal_by_baseline.R

@@ -31,7 +31,7 @@
 #' @param abnormal (`character`)\cr values identifying the abnormal range level(s) in `.var`.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("abnormal_by_baseline"))``
+#'   Options are: ``r shQuote(get_stats("abnormal_by_baseline"), type = "sh")``
 #'
 #' @note
 #' * `df` should be filtered to include only post-baseline records.

R/abnormal_by_marked.R

@@ -30,7 +30,7 @@
 #'   and last or replicated.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("abnormal_by_marked"))``
+#'   Options are: ``r shQuote(get_stats("abnormal_by_marked"), type = "sh")``
 #'
 #' @note `Single, not last` and `Last or replicated` levels are mutually exclusive. If a patient has
 #'   abnormalities that meet both the `Single, not last` and `Last or replicated` criteria, then the

R/abnormal_by_worst_grade.R

@@ -29,7 +29,7 @@
 #' @inheritParams argument_convention
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("abnormal_by_worst_grade"))``
+#'   Options are: ``r shQuote(get_stats("abnormal_by_worst_grade"), type = "sh")``
 #'
 #' @seealso [h_adlb_abnormal_by_worst_grade()] which pre-processes ADLB data frames to be used in
 #'   [count_abnormal_by_worst_grade()].

R/abnormal_by_worst_grade_worsen.R

@@ -30,7 +30,7 @@
 #'   * `direction_var` (`string`)\cr see `direction_var` for more details.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("abnormal_by_worst_grade_worsen"))``
+#'   Options are: ``r shQuote(get_stats("abnormal_by_worst_grade_worsen"), type = "sh")``
 #'
 #' @seealso Relevant helper functions [h_adlb_worsen()] and [h_worsen_counter()] which are used within
 #' [s_count_abnormal_lab_worsen_by_baseline()] to process input data.

R/analyze_variables.R

@@ -61,9 +61,9 @@ control_analyze_vars <- function(conf_level = 0.95,
 #' @inheritParams argument_convention
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options for numeric variables are: ``r shQuote(get_stats("analyze_vars_numeric"))``
+#'   Options for numeric variables are: ``r shQuote(get_stats("analyze_vars_numeric"), type = "sh")``
 #'
-#'   Options for non-numeric variables are: ``r shQuote(get_stats("analyze_vars_counts"))``
+#'   Options for non-numeric variables are: ``r shQuote(get_stats("analyze_vars_counts"), type = "sh")``
 #'
 #' @name analyze_variables
 #' @order 1
@@ -541,7 +541,7 @@ s_summary.logical <- function(x, denom = c("n", "N_col", "N_row"), ...) {
 a_summary <- function(x,
                       ...,
                       .stats = NULL,
-                      .stat_names_in = NULL,
+                      .stat_names = NULL,
                       .formats = NULL,
                       .labels = NULL,
                       .indent_mods = NULL) {
@@ -562,11 +562,6 @@ a_summary <- function(x,
   )
   dots_extra_args$.additional_fun_parameters <- NULL # After extraction we do not need them anymore
 
-  # If one col has NA vals, must add NA row to other cols (using placeholder lvl `fill-na-level`)
-  if (any(is.na(dots_extra_args$.df_row[[dots_extra_args$.var]])) && !any(is.na(x)) && !dots_extra_args$na_rm) {
-    levels(x) <- c(levels(x), "fill-na-level")
-  }
-
   # Check if compare_with_ref_group is TRUE but no ref col is set
   if (isTRUE(dots_extra_args$compare_with_ref_group) &&
     all(
@@ -576,7 +571,7 @@ a_summary <- function(x,
   ) {
     stop(
       "For comparison (compare_with_ref_group = TRUE), the reference group must be specified.",
-      "\nSee split_fun in spit_cols_by()."
+      "\nSee ref_group in split_cols_by()."
     )
   }
 
@@ -602,55 +597,58 @@ a_summary <- function(x,
   )
 
   x_stats <- x_stats[.stats]
-  if (is.character(x) || is.factor(x)) {
-    levels_per_stats <- lapply(x_stats, names) # if there is a count is table() with levels
+
+  is_char <- is.character(x) || is.factor(x)
+  if (is_char) {
+    levels_per_stats <- lapply(x_stats, names)
   } else {
-    levels_per_stats <- NULL
+    levels_per_stats <- names(x_stats) %>%
+      as.list() %>%
+      setNames(names(x_stats))
   }
 
-  # Formats checks
-  .formats <- get_formats_from_stats(.stats, .formats)
+  # Fill in formats/indents/labels with custom input and defaults
+  .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats)
+  lbls <- get_labels_from_stats(.stats, .labels, levels_per_stats)
 
-  # Auto format handling
-  .formats <- apply_auto_formatting(
-    .formats,
-    x_stats,
-    extra_afun_params$.df_row,
-    extra_afun_params$.var
-  )
+  if (is_char) {
+    # Keep pval_counts stat if present from comparisons and empty
+    if ("pval_counts" %in% names(x_stats) && length(x_stats[["pval_counts"]]) == 0) {
+      x_stats[["pval_counts"]] <- list(NULL) %>% setNames("pval_counts")
+    }
 
-  # Indentation checks
-  .indent_mods <- get_indents_from_stats(.stats, .indent_mods)
+    # Unlist stats
+    x_stats <- x_stats %>%
+      .unlist_keep_nulls() %>%
+      setNames(names(.formats))
+  }
 
-  # Labels assignments
-  lbls <- get_labels_from_stats(.stats, .labels, levels_per_stats)
   # Check for custom labels from control_analyze_vars
   .labels <- if ("control" %in% names(dots_extra_args)) {
     labels_use_control(lbls, dots_extra_args[["control"]], .labels)
   } else {
     lbls
   }
 
-  if (is.character(x) || is.factor(x)) {
-    # Ungroup statistics with values for each level of x
-    x_ungrp <- ungroup_stats(x_stats, .formats, .indent_mods)
-    x_stats <- x_ungrp[["x"]]
-    .formats <- x_ungrp[[".formats"]]
-    .indent_mods <- x_ungrp[[".indent_mods"]]
-    .labels <- .unlist_keep_nulls(.labels)
-    .labels <- gsub("fill-na-level", "NA", .labels)
-  }
+  # Auto format handling
+  .formats <- apply_auto_formatting(
+    .formats,
+    x_stats,
+    extra_afun_params$.df_row,
+    extra_afun_params$.var
+  )
 
   # Get and check statistical names from defaults
-  .stat_names <- get_stat_names(x_stats, .stat_names_in) # note is x_stats
+  .stat_names <- get_stat_names(x_stats, .stat_names) # note is x_stats
 
   in_rows(
     .list = x_stats,
     .formats = .formats,
     .names = names(.labels),
     .stat_names = .stat_names,
-    .labels = .labels,
-    .indent_mods = .indent_mods
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls()
   )
 }
 
@@ -747,7 +745,7 @@ analyze_vars <- function(lyt,
                          na_rm = TRUE,
                          compare_with_ref_group = FALSE,
                          .stats = c("n", "mean_sd", "median", "range", "count_fraction"),
-                         .stat_names_in = NULL,
+                         .stat_names = NULL,
                          .formats = NULL,
                          .labels = NULL,
                          .indent_mods = NULL) {
@@ -760,12 +758,11 @@ analyze_vars <- function(lyt,
 
   # Needed defaults
   if (!is.null(.stats)) extra_args[[".stats"]] <- .stats
-  if (!is.null(.stat_names_in)) extra_args[[".stat_names_in"]] <- .stat_names_in
+  if (!is.null(.stat_names)) extra_args[[".stat_names"]] <- .stat_names
   if (!is.null(.formats)) extra_args[[".formats"]] <- .formats
   if (!is.null(.labels)) extra_args[[".labels"]] <- .labels
   if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods
 
-
   # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params)
   extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
   formals(a_summary) <- c(

R/analyze_vars_in_cols.R

@@ -174,7 +174,7 @@ analyze_vars_in_cols <- function(lyt,
   met_grps <- paste0("analyze_vars", c("_numeric", "_counts"))
   .stats <- get_stats(met_grps, stats_in = .stats)
   formats_v <- get_formats_from_stats(stats = .stats, formats_in = .formats)
-  labels_v <- get_labels_from_stats(stats = .stats, labels_in = .labels)
+  labels_v <- get_labels_from_stats(stats = .stats, labels_in = .labels) %>% .unlist_keep_nulls()
   if ("control" %in% names(extra_args)) labels_v <- labels_v %>% labels_use_control(extra_args[["control"]], .labels)
 
   # Check for vars in the case that one or more are used

R/argument_convention.R

@@ -23,7 +23,7 @@
 #' @param .spl_context (`data.frame`)\cr gives information about ancestor split states
 #'   that is passed by `rtables`.
 #' @param .stats (`character`)\cr statistics to select for the table.
-#' @param .stat_names_in (`character`)\cr names of the statistics that are passed directly to name single statistics
+#' @param .stat_names (`character`)\cr names of the statistics that are passed directly to name single statistics
 #'   (`.stats`). This option is visible when producing [rtables::as_result_df()] with `make_ard = TRUE`.
 #' @param .var (`string`)\cr single variable name that is passed by `rtables` when requested
 #'   by a statistics function.

R/compare_variables.R

@@ -16,9 +16,9 @@
 #' @inheritParams argument_convention
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options for numeric variables are: ``r shQuote(get_stats("analyze_vars_numeric", add_pval = TRUE))``
+#'  Options for numeric variables are: ``r shQuote(get_stats("analyze_vars_numeric", add_pval = TRUE), type = "sh")``
 #'
-#'   Options for non-numeric variables are: ``r shQuote(get_stats("analyze_vars_counts", add_pval = TRUE))``
+#'  Options for non-numeric variables are: ``r shQuote(get_stats("analyze_vars_counts", add_pval = TRUE), type = "sh")``
 #'
 #' @note
 #' * For factor variables, `denom` for factor proportions can only be `n` since the purpose is to compare proportions
@@ -219,7 +219,7 @@ compare_vars <- function(lyt,
                          table_names = vars,
                          section_div = NA_character_,
                          .stats = c("n", "mean_sd", "count_fraction", "pval"),
-                         .stat_names_in = NULL,
+                         .stat_names = NULL,
                          .formats = NULL,
                          .labels = NULL,
                          .indent_mods = NULL) {
@@ -235,7 +235,7 @@ compare_vars <- function(lyt,
     table_names = table_names,
     section_div = section_div,
     .stats = .stats,
-    .stat_names_in = .stat_names_in,
+    .stat_names = .stat_names,
     .formats = .formats,
     .labels = .labels,
     .indent_mods = .indent_mods,

R/count_cumulative.R

@@ -16,7 +16,7 @@
 #' @param thresholds (`numeric`)\cr vector of cutoff values for the counts.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("count_cumulative"))``
+#'   Options are: ``r shQuote(get_stats("count_cumulative"), type = "sh")``
 #'
 #' @seealso Relevant helper function [h_count_cumulative()], and descriptive function [d_count_cumulative()].
 #'

R/count_missed_doses.R

@@ -14,7 +14,7 @@
 #' @param thresholds (`numeric`)\cr minimum number of missed doses the patients had.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("count_missed_doses"))``
+#'   Options are: ``r shQuote(get_stats("count_missed_doses"), type = "sh")``
 #'
 #' @seealso
 #' * Relevant description function [d_count_missed_doses()] which generates labels for [count_missed_doses()].

R/count_occurrences.R

@@ -19,7 +19,7 @@
 #'   Note that in that case the remaining occurrence levels in the table are sorted alphabetically.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("count_occurrences"))``
+#'   Options are: ``r shQuote(get_stats("count_occurrences"), type = "sh")``
 #'
 #' @note By default, occurrences which don't appear in a given row split are dropped from the table and
 #'   the occurrences in the table are sorted alphabetically per row split. Therefore, the corresponding layout
@@ -175,26 +175,24 @@ a_count_occurrences <- function(df,
 
   # Fill in with formatting defaults if needed
   .stats <- get_stats("count_occurrences", stats_in = .stats)
-  .formats <- get_formats_from_stats(.stats, .formats)
-  .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels, levels_per_stats = lapply(x_stats, names)))
-  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = names(x_stats[[1]]))
-
   x_stats <- x_stats[.stats]
+  levels_per_stats <- lapply(x_stats, names)
+  .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats)
+  .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats)
 
-  # Ungroup statistics with values for each level of x
-  x_ungrp <- ungroup_stats(x_stats, .formats, list())
-  x_stats <- x_ungrp[["x"]]
-  .formats <- x_ungrp[[".formats"]]
+  # Unlist stats
+  x_stats <- x_stats %>% .unlist_keep_nulls()
 
   # Auto format handling
   .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var)
 
   in_rows(
     .list = x_stats,
     .formats = .formats,
-    .names = .labels,
-    .labels = .labels,
-    .indent_mods = .indent_mods,
+    .names = .labels %>% .unlist_keep_nulls(),
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
     .format_na_strs = na_str
   )
 }

R/count_occurrences_by_grade.R

@@ -27,7 +27,7 @@
 #'   should be displayed (`FALSE`).
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("count_occurrences_by_grade"))``
+#'   Options are: ``r shQuote(get_stats("count_occurrences_by_grade"), type = "sh")``
 #'
 #' @seealso Relevant helper function [h_append_grade_groups()].
 #'
@@ -274,29 +274,24 @@ a_count_occurrences_by_grade <- function(df,
 
   # Fill in with formatting defaults if needed
   .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats)
-  if (length(.formats) == 1 && is.null(names(.formats))) {
-    .formats <- rep(.formats, length(.stats)) %>% setNames(.stats)
-  }
-  .formats <- get_formats_from_stats(.stats, .formats)
-  .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels, lapply(x_stats, names)))
-  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = names(x_stats[[1]]))
-
   x_stats <- x_stats[.stats]
+  levels_per_stats <- lapply(x_stats, names)
+  .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats)
+  .labels <- get_labels_from_stats(.stats, .labels, levels_per_stats)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats)
 
-  # Ungroup statistics with values for each level of x
-  x_ungrp <- ungroup_stats(x_stats, .formats, list())
-  x_stats <- x_ungrp[["x"]]
-  .formats <- x_ungrp[[".formats"]]
+  # Unlist stats
+  x_stats <- x_stats %>% .unlist_keep_nulls()
 
   # Auto format handling
   .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var)
 
   in_rows(
     .list = x_stats,
     .formats = .formats,
-    .names = .labels,
-    .labels = .labels,
-    .indent_mods = .indent_mods,
+    .names = .labels %>% .unlist_keep_nulls(),
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
     .format_na_strs = na_str
   )
 }

R/count_patients_events_in_cols.R

@@ -22,7 +22,7 @@
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
 #'   In addition to any statistics added using `filters_list`, statistic options are:
-#'   ``r shQuote(get_stats("summarize_patients_events_in_cols"))``
+#'   ``r shQuote(get_stats("summarize_patients_events_in_cols"), type = "sh")``
 #'
 #' @name count_patients_events_in_cols
 #' @order 1

R/count_patients_with_event.R

@@ -19,7 +19,7 @@
 #'   Note that only equality is being accepted as condition.
 #' @param .stats (`character`)\cr statistics to select for the table.
 #'
-#'   Options are: ``r shQuote(get_stats("count_patients_with_event"))``
+#'   Options are: ``r shQuote(get_stats("count_patients_with_event"), type = "sh")``
 #'
 #' @seealso [count_patients_with_flags()]
 #'
@@ -138,8 +138,8 @@ a_count_patients_with_event <- function(df,
     .list = x_stats,
     .formats = .formats,
     .names = names(.labels),
-    .labels = .labels,
-    .indent_mods = .indent_mods,
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
     .format_na_strs = na_str
   )
 }