Fix label and indentation processors

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/analyze_variables.R

@@ -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,44 +597,47 @@ 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
@@ -649,8 +647,8 @@ a_summary <- function(x,
     .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()
   )
 }
 

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/count_occurrences.R

@@ -175,26 +175,27 @@ 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,
+    rep(0L, length(levels_per_stats[[1]])) %>% as.list() %>% setNames(levels_per_stats[[1]])
+  )
 
-  # 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

@@ -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_with_event.R

@@ -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
   )
 }

R/count_patients_with_flags.R

@@ -121,6 +121,7 @@ a_count_patients_with_flags <- function(df,
                                         .df_row,
                                         .var = NULL,
                                         .stats = NULL,
+                                        .stat_names_in = NULL,
                                         .formats = NULL,
                                         .labels = NULL,
                                         .indent_mods = NULL,
@@ -129,43 +130,43 @@ a_count_patients_with_flags <- function(df,
     df = df, .var = .var, flag_variables = flag_variables, flag_labels = flag_labels,
     .N_col = .N_col, .N_row = .N_row, denom = denom
   )
+  if (is.null(names(flag_variables))) flag_variables <- formatters::var_labels(df, fill = TRUE)[flag_variables]
+  if (is.null(flag_labels)) flag_labels <- flag_variables
 
   if (is.null(unlist(x_stats))) {
     return(NULL)
   }
 
   # Fill in with formatting defaults if needed
   .stats <- get_stats("count_patients_with_flags", stats_in = .stats)
-  x_stats <- x_stats[.stats]
-
-  .formats <- get_formats_from_stats(.stats, .formats)
-
-  # label formatting
-  x_nms <- paste(rep(.stats, each = length(flag_variables)), flag_variables, sep = ".")
-  new_lbls <- if (!is.null(.labels)) .labels[names(.labels) %in% x_nms] else NULL
-  .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels,
-    levels_per_stats = lapply(x_stats, names)
-  )) %>%
-    setNames(x_nms)
-
-  # indent mod formatting
-  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = flag_variables)
+  levels_per_stats <- rep(list(names(flag_variables)), length(.stats)) %>% setNames(.stats)
+  .formats <- get_formats_from_stats(.stats, .formats, levels_per_stats)
+  .indent_mods <- get_indents_from_stats(.stats, .indent_mods, levels_per_stats)
+  .labels <- get_labels_from_stats(
+    .stats, .labels, levels_per_stats,
+    flag_labels %>% setNames(names(flag_variables))
+  )
 
+  x_stats <- x_stats[.stats]
 
-  # Ungroup statistics with values for each level of x
-  x_ungrp <- ungroup_stats(x_stats, .formats, list())
-  x_stats <- x_ungrp[["x"]] %>% setNames(x_nms)
-  .formats <- x_ungrp[[".formats"]] %>% setNames(x_nms)
+  # Unlist stats
+  x_stats <- x_stats %>%
+    .unlist_keep_nulls() %>%
+    setNames(names(.formats))
 
   # Auto format handling
   .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var)
 
+  # Get and check statistical names from defaults
+  .stat_names <- get_stat_names(x_stats, .stat_names_in)
+
   in_rows(
     .list = x_stats,
     .formats = .formats,
     .names = names(.labels),
-    .labels = .labels,
-    .indent_mods = .indent_mods,
+    .stat_names = .stat_names,
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
     .format_na_strs = na_str
   )
 }
@@ -216,12 +217,14 @@ count_patients_with_flags <- function(lyt,
                                       ...,
                                       table_names = paste0("tbl_flags_", var),
                                       .stats = "count_fraction",
+                                      .stat_names_in = NULL,
                                       .formats = list(count_fraction = format_count_fraction_fixed_dp),
                                       .indent_mods = NULL,
                                       .labels = NULL) {
   checkmate::assert_flag(riskdiff)
   extra_args <- list(
-    .stats = .stats, .formats = .formats, .labels = .labels, .indent_mods = .indent_mods, na_str = na_str
+    .stats = .stats, .stat_names_in = .stat_names_in, .formats = .formats, .labels = .labels,
+    .indent_mods = .indent_mods, na_str = na_str
   )
   s_args <- list(flag_variables = flag_variables, flag_labels = flag_labels, ...)
 

R/count_values.R

@@ -110,6 +110,7 @@ s_count_values.logical <- function(x, values = TRUE, ...) {
 a_count_values <- function(x,
                            ...,
                            .stats = NULL,
+                           .stat_names_in = NULL,
                            .formats = NULL,
                            .labels = NULL,
                            .indent_mods = NULL) {
@@ -146,6 +147,8 @@ a_count_values <- function(x,
   .labels <- get_labels_from_stats(.stats, .labels)
   .indent_mods <- get_indents_from_stats(.stats, .indent_mods)
 
+  x_stats <- x_stats[.stats]
+
   # Auto format handling
   .formats <- apply_auto_formatting(
     .formats,
@@ -154,12 +157,16 @@ a_count_values <- function(x,
     extra_afun_params$.var
   )
 
+  # Get and check statistic names from defaults
+  .stat_names <- get_stat_names(x_stats, .stat_names_in)
+
   in_rows(
-    .list = x_stats[.stats],
+    .list = x_stats,
     .formats = .formats,
     .names = names(.labels),
-    .labels = .labels,
-    .indent_mods = .indent_mods
+    .stat_names = .stat_names,
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls()
   )
 }
 
@@ -188,18 +195,18 @@ count_values <- function(lyt,
                          ...,
                          table_names = vars,
                          .stats = "count_fraction",
+                         .stat_names_in = NULL,
                          .formats = c(count_fraction = "xx (xx.xx%)", count = "xx"),
                          .labels = c(count_fraction = paste(values, collapse = ", ")),
                          .indent_mods = NULL) {
   # Process extra args
-  extra_args <- list(".stats" = .stats)
+  extra_args <- list("na_rm" = na_rm, "values" = values, ...)
+  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(.formats)) extra_args[[".formats"]] <- .formats
   if (!is.null(.labels)) extra_args[[".labels"]] <- .labels
   if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods
 
-  # Add additional arguments to the analysis function
-  extra_args <- c(extra_args, "na_rm" = na_rm, "values" = list(values), ...)
-
   # Adding additional info from layout to analysis function
   extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE)
   formals(a_count_values) <- c(formals(a_count_values), extra_args[[".additional_fun_parameters"]])

R/g_lineplot.R

@@ -186,12 +186,12 @@ g_lineplot <- function(df,
 
   if (!is.null(table)) {
     table_format <- get_formats_from_stats(table)
-    table_labels <- get_labels_from_stats(table)
+    table_labels <- get_labels_from_stats(table) %>% .unlist_keep_nulls()
   }
 
   extra_args <- list(...)
   if ("control" %in% names(extra_args)) {
-    if (!is.null(table) && all(table_labels == get_labels_from_stats(table))) {
+    if (!is.null(table) && all(table_labels == .unlist_keep_nulls(get_labels_from_stats(table)))) {
       table_labels <- table_labels %>% labels_use_control(extra_args[["control"]])
     }
   }

R/incidence_rate.R

@@ -172,8 +172,8 @@ a_incidence_rate <- function(df,
   in_rows(
     .list = x_stats,
     .formats = .formats,
-    .labels = .labels,
-    .indent_mods = .indent_mods,
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls(),
     .format_na_strs = na_str
   )
 }

R/summarize_change.R

@@ -108,8 +108,8 @@ a_change_from_baseline <- function(df,
     .list = x_stats[.stats],
     .formats = .formats,
     .names = names(.labels),
-    .labels = .labels,
-    .indent_mods = .indent_mods
+    .labels = .labels %>% .unlist_keep_nulls(),
+    .indent_mods = .indent_mods %>% .unlist_keep_nulls()
   )
 }