Implement na_str argument in all columnwise analysis functions (#1140)

Fixes #1139
insightsengineering · Nov 27, 2023 · 2bfd695 · 2bfd695
1 parent 649f0f2
commit 2bfd695
Show file tree

Hide file tree

Showing 27 changed files with 256 additions and 24 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -21,6 +21,7 @@
 
 ### Bug Fixes
 * Fixed bug in `decorate_grob` preventing text wrapping from accounting for font size.
+* Fixed implementation of `na_str` argument in all column-wise analysis and tabulation functions.
 
 ### Miscellaneous
 * Specified minimal version of package dependencies.

diff --git a/R/analyze_vars_in_cols.R b/R/analyze_vars_in_cols.R
@@ -378,6 +378,7 @@ analyze_vars_in_cols <- function(lyt,
     # Main call to rtables
     analyze_colvars(lyt,
       afun = afun_list,
+      na_str = na_str,
       nested = nested,
       extra_args = extra_args
     )

diff --git a/R/h_response_biomarkers_subgroups.R b/R/h_response_biomarkers_subgroups.R
@@ -185,8 +185,9 @@ h_logistic_mult_cont_df <- function(variables,
 #' @export
 h_tab_rsp_one_biomarker <- function(df,
                                     vars,
+                                    na_str = NA_character_,
                                     .indent_mods = 0L) {
-  afuns <- a_response_subgroups()[vars]
+  afuns <- a_response_subgroups(na_str = na_str)[vars]
   colvars <- d_rsp_subgroups_colvars(
     vars,
     conf_level = df$conf_level[1],
@@ -196,6 +197,7 @@ h_tab_rsp_one_biomarker <- function(df,
     df = df,
     afuns = afuns,
     colvars = colvars,
+    na_str = na_str,
     .indent_mods = .indent_mods
   )
 }
diff --git a/R/h_survival_biomarkers_subgroups.R b/R/h_survival_biomarkers_subgroups.R
@@ -197,9 +197,10 @@ h_coxreg_mult_cont_df <- function(variables,
 h_tab_surv_one_biomarker <- function(df,
                                      vars,
                                      time_unit,
+                                     na_str = NA_character_,
                                      .indent_mods = 0L,
                                      ...) {
-  afuns <- a_survival_subgroups()[vars]
+  afuns <- a_survival_subgroups(na_str = na_str)[vars]
   colvars <- d_survival_subgroups_colvars(
     vars,
     conf_level = df$conf_level[1],
@@ -210,6 +211,7 @@ h_tab_surv_one_biomarker <- function(df,
     df = df,
     afuns = afuns,
     colvars = colvars,
+    na_str = na_str,
     .indent_mods = .indent_mods,
     ...
   )

diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R
@@ -68,6 +68,7 @@
 #' @name response_biomarkers_subgroups
 tabulate_rsp_biomarkers <- function(df,
                                     vars = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"),
+                                    na_str = NA_character_,
                                     .indent_mods = 0L) {
   checkmate::assert_data_frame(df)
   checkmate::assert_character(df$biomarker)
@@ -79,6 +80,7 @@ tabulate_rsp_biomarkers <- function(df,
     tab_sub <- h_tab_rsp_one_biomarker(
       df = df_sub,
       vars = vars,
+      na_str = na_str,
       .indent_mods = .indent_mods
     )
     # Insert label row as first row in table.

diff --git a/R/response_subgroups.R b/R/response_subgroups.R
@@ -123,27 +123,39 @@ a_response_subgroups <- function(.formats = list(
                                    or = list(format_extreme_values(2L)),
                                    ci = list(format_extreme_values_ci(2L)),
                                    pval = "x.xxxx | (<0.0001)" # nolint end
-                                 )) {
+                                 ),
+                                 na_str = NA_character_) {
   checkmate::assert_list(.formats)
   checkmate::assert_subset(
     names(.formats),
     c("n", "n_rsp", "prop", "n_tot", "or", "ci", "pval")
   )
 
   afun_lst <- Map(
-    function(stat, fmt) {
+    function(stat, fmt, na_str) {
       if (stat == "ci") {
         function(df, labelstr = "", ...) {
-          in_rows(.list = combine_vectors(df$lcl, df$ucl), .labels = as.character(df$subgroup), .formats = fmt)
+          in_rows(
+            .list = combine_vectors(df$lcl, df$ucl),
+            .labels = as.character(df$subgroup),
+            .formats = fmt,
+            .format_na_strs = na_str
+          )
         }
       } else {
         function(df, labelstr = "", ...) {
-          in_rows(.list = as.list(df[[stat]]), .labels = as.character(df$subgroup), .formats = fmt)
+          in_rows(
+            .list = as.list(df[[stat]]),
+            .labels = as.character(df$subgroup),
+            .formats = fmt,
+            .format_na_strs = na_str
+          )
         }
       }
     },
     stat = names(.formats),
-    fmt = .formats
+    fmt = .formats,
+    na_str = na_str
   )
 
   afun_lst
@@ -185,7 +197,8 @@ tabulate_rsp_subgroups <- function(lyt,
                                    df,
                                    vars = c("n_tot", "n", "prop", "or", "ci"),
                                    groups_lists = list(),
-                                   label_all = "All Patients") {
+                                   label_all = "All Patients",
+                                   na_str = NA_character_) {
   conf_level <- df$or$conf_level[1]
   method <- if ("pval_label" %in% names(df$or)) {
     df$or$pval_label[1]
@@ -195,7 +208,7 @@ tabulate_rsp_subgroups <- function(lyt,
 
   extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method, label_all = label_all)
 
-  afun_lst <- a_response_subgroups()
+  afun_lst <- a_response_subgroups(na_str = na_str)
   colvars <- d_rsp_subgroups_colvars(vars, conf_level = conf_level, method = method)
 
   colvars_prop <- list(
@@ -227,6 +240,7 @@ tabulate_rsp_subgroups <- function(lyt,
     lyt_prop <- analyze_colvars(
       lyt = lyt_prop,
       afun = afun_lst[names(colvars_prop$labels)],
+      na_str = na_str,
       extra_args = extra_args
     )
 
@@ -242,6 +256,7 @@ tabulate_rsp_subgroups <- function(lyt,
       lyt_prop <- analyze_colvars(
         lyt = lyt_prop,
         afun = afun_lst[names(colvars_prop$labels)],
+        na_str = na_str,
         inclNAs = TRUE,
         extra_args = extra_args
       )
@@ -271,6 +286,7 @@ tabulate_rsp_subgroups <- function(lyt,
   lyt_or <- analyze_colvars(
     lyt = lyt_or,
     afun = afun_lst[names(colvars_or$labels)],
+    na_str = na_str,
     extra_args = extra_args
   ) %>%
     append_topleft("Baseline Risk Factors")
@@ -287,6 +303,7 @@ tabulate_rsp_subgroups <- function(lyt,
     lyt_or <- analyze_colvars(
       lyt = lyt_or,
       afun = afun_lst[names(colvars_or$labels)],
+      na_str = na_str,
       inclNAs = TRUE,
       extra_args = extra_args
     )

diff --git a/R/summarize_colvars.R b/R/summarize_colvars.R
@@ -81,6 +81,7 @@ summarize_colvars <- function(lyt,
   analyze_colvars(
     lyt,
     afun = a_summary,
+    na_str = na_str,
     extra_args = extra_args
   )
 }
diff --git a/R/summarize_coxreg.R b/R/summarize_coxreg.R
@@ -395,6 +395,7 @@ summarize_coxreg <- function(lyt,
       lyt <- lyt %>%
         analyze_colvars(
           afun = a_coxreg,
+          na_str = na_str,
           extra_args = list(
             variables = variables, control = control, multivar = multivar, eff = TRUE, var_main = multivar,
             labelstr = ""
@@ -411,6 +412,7 @@ summarize_coxreg <- function(lyt,
         ) %>%
         analyze_colvars(
           afun = a_coxreg,
+          na_str = na_str,
           extra_args = list(eff = TRUE, control = control, variables = variables, multivar = multivar, labelstr = "")
         )
     }
@@ -441,6 +443,7 @@ summarize_coxreg <- function(lyt,
       lyt <- lyt %>%
         analyze_colvars(
           afun = a_coxreg,
+          na_str = na_str,
           extra_args = list(
             variables = variables, at = at, control = control, multivar = multivar,
             var_main = if (multivar) multivar else control$interaction,
@@ -454,6 +457,7 @@ summarize_coxreg <- function(lyt,
       lyt <- lyt %>%
         analyze_colvars(
           afun = a_coxreg,
+          na_str = na_str,
           extra_args = list(variables = variables, at = at, control = control, multivar = multivar, labelstr = ""),
           indent_mod = if (!"arm" %in% names(variables) || multivar) 0L else -1L
         )

diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R
@@ -273,6 +273,7 @@ analyze_patients_exposure_in_cols <- function(lyt, # nolint
                                               add_total_level = FALSE,
                                               custom_label = NULL,
                                               col_split = TRUE,
+                                              na_str = NA_character_,
                                               .stats = c("n_patients", "sum_exposure"),
                                               .labels = c(n_patients = "Patients", sum_exposure = "Person time"),
                                               .indent_mods = 0L,
@@ -292,6 +293,7 @@ analyze_patients_exposure_in_cols <- function(lyt, # nolint
   lyt <- lyt %>% analyze_colvars(
     afun = a_count_patients_sum_exposure,
     indent_mod = .indent_mods,
+    na_str = na_str,
     extra_args = extra_args
   )
   lyt

diff --git a/R/survival_biomarkers_subgroups.R b/R/survival_biomarkers_subgroups.R
@@ -185,6 +185,7 @@ tabulate_survival_biomarkers <- function(df,
                                          control = control_coxreg(),
                                          label_all = "All Patients",
                                          time_unit = NULL,
+                                         na_str = NA_character_,
                                          .indent_mods = 0L) {
   checkmate::assert_data_frame(df)
   checkmate::assert_character(df$biomarker)
@@ -199,6 +200,7 @@ tabulate_survival_biomarkers <- function(df,
       df = df_sub,
       vars = vars,
       time_unit = time_unit,
+      na_str = na_str,
       .indent_mods = .indent_mods,
       extra_args = extra_args
     )

diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R
@@ -148,35 +148,39 @@ a_survival_subgroups <- function(.formats = list( # nolint start
                                    hr = list(format_extreme_values(2L)),
                                    ci = list(format_extreme_values_ci(2L)),
                                    pval = "x.xxxx | (<0.0001)"
-                                 )) { # nolint end
+                                 ),
+                                 na_str = NA_character_) { # nolint end
   checkmate::assert_list(.formats)
   checkmate::assert_subset(
     names(.formats),
     c("n", "n_events", "median", "n_tot", "n_tot_events", "hr", "ci", "pval")
   )
 
   afun_lst <- Map(
-    function(stat, fmt) {
+    function(stat, fmt, na_str) {
       if (stat == "ci") {
         function(df, labelstr = "", ...) {
           in_rows(
             .list = combine_vectors(df$lcl, df$ucl),
             .labels = as.character(df$subgroup),
-            .formats = fmt
+            .formats = fmt,
+            .format_na_strs = na_str
           )
         }
       } else {
         function(df, labelstr = "", ...) {
           in_rows(
             .list = as.list(df[[stat]]),
             .labels = as.character(df$subgroup),
-            .formats = fmt
+            .formats = fmt,
+            .format_na_strs = na_str
           )
         }
       }
     },
     stat = names(.formats),
-    fmt = .formats
+    fmt = .formats,
+    na_str = na_str
   )
 
   afun_lst
@@ -215,7 +219,7 @@ tabulate_survival_subgroups <- function(lyt,
 
   extra_args <- list(groups_lists = groups_lists, conf_level = conf_level, method = method, label_all = label_all)
 
-  afun_lst <- a_survival_subgroups()
+  afun_lst <- a_survival_subgroups(na_str = na_str)
   colvars <- d_survival_subgroups_colvars(
     vars,
     conf_level = conf_level,
@@ -266,6 +270,7 @@ tabulate_survival_subgroups <- function(lyt,
       lyt_survtime <- analyze_colvars(
         lyt = lyt_survtime,
         afun = afun_lst[names(colvars_survtime$labels)],
+        na_str = na_str,
         inclNAs = TRUE,
         extra_args = extra_args
       )
@@ -310,6 +315,7 @@ tabulate_survival_subgroups <- function(lyt,
     lyt_hr <- analyze_colvars(
       lyt = lyt_hr,
       afun = afun_lst[names(colvars_hr$labels)],
+      na_str = na_str,
       inclNAs = TRUE,
       extra_args = extra_args
     )

diff --git a/man/h_response_biomarkers_subgroups.Rd b/man/h_response_biomarkers_subgroups.Rd
diff --git a/man/h_survival_biomarkers_subgroups.Rd b/man/h_survival_biomarkers_subgroups.Rd
diff --git a/man/response_biomarkers_subgroups.Rd b/man/response_biomarkers_subgroups.Rd
diff --git a/man/response_subgroups.Rd b/man/response_subgroups.Rd