tentative solution for multiple calls of analyze_vars_in_cols

R/analyze_vars_in_cols.R

@@ -1,18 +1,39 @@
 #' Summary numeric variables in columns
 #'
-#' @description `r lifecycle::badge("stable")`
+#' @description `r lifecycle::badge("experimental")`
 #'
 #' Layout-creating function which can be used for creating column-wise summary tables, primarily
 #' used for PK data sets. This function is a wrapper for [rtables::analyze_colvars()].
 #'
 #' @inheritParams argument_convention
 #' @inheritParams rtables::analyze_colvars
+#' @param row_labels (`character`)\cr as this function works in columns space, usual `.labels`
+#'   character vector applies on the column space. You can change the row labels by defining this
+#'   parameter to a named character vector with names corresponding to the split values. It defaults
+#'   to `NULL` and if it contains only one `string`, it will duplicate that as a row label.
+#' @param do_summarize_row_groups (`flag`)\cr defaults to `FALSE` and applies the analysis to the current
+#'   label rows. This is a wrapper of [rtables::summarize_row_groups()] and it can accept `labelstr`
+#'   to define row labels. This behavior is not supported as we never need to overload row labels.
+#' @param split_col_vars (`flag`)\cr defaults to `TRUE` and puts the analysis results onto the columns.
+#'   This option allows you to add multiple instances of this functions, also in a nested fashion,
+#'   without adding more splits. This split must happen only one time on a single layout.
 #'
 #' @return
 #' A layout object suitable for passing to further layouting functions, or to [rtables::build_table()].
 #' Adding this function to an `rtable` layout will summarize the given variables, arrange the output
 #' in columns, and add it to the table layout.
 #'
+#' @note This is an experimental implementation of [rtables::summarize_row_groups()] and
+#'   [rtables::analyze_colvars()] that may be subjected to changes as `rtables` extends its
+#'   support to more complex analysis pipelines on the column space. For the same reasons,
+#'   we encourage to read the examples carefully and file issues for cases that differ from
+#'   them.
+#'
+#'   Here `labelstr` behaves differently than usual. If it is not defined (default as `NULL`),
+#'   row labels are assigned automatically to the split values in case of `rtables::analyze_colvars`
+#'   (`do_summarize_row_groups = FALSE`, the default), and to the group label for
+#'   `do_summarize_row_groups = TRUE`.
+#'
 #' @seealso [summarize_vars()], [rtables::analyze_colvars()].
 #'
 #' @examples
@@ -54,7 +75,6 @@
 #' result <- build_table(lyt, df = adpp)
 #' result
 #'
-#' # PKPT03
 #' lyt <- basic_table() %>%
 #'   split_rows_by(var = "TLG_DISPLAY", split_label = "PK Parameter", label_pos = "topleft") %>%
 #'   analyze_vars_in_cols(
@@ -75,6 +95,8 @@
 #' result <- build_table(lyt, df = adpp)
 #' result
 #'
+#' # Multiple calls
+#'
 #' @export
 analyze_vars_in_cols <- function(lyt,
                                  vars,
@@ -95,13 +117,19 @@ analyze_vars_in_cols <- function(lyt,
                                    cv = "CV (%)",
                                    geom_cv = "CV % Geometric Mean"
                                  ),
-                                 labelstr = " ",
+                                 row_labels = NULL,
+                                 do_summarize_row_groups = FALSE,
+                                 split_col_vars = TRUE,
+                                 .indent_mods = NULL,
                                  nested = TRUE,
                                  na_level = NULL,
                                  .formats = NULL) {
   checkmate::assert_string(na_level, null.ok = TRUE)
-  checkmate::assert_string(labelstr)
+  checkmate::assert_character(row_labels, null.ok = TRUE)
+  checkmate::assert_int(.indent_mods, null.ok = TRUE)
   checkmate::assert_flag(nested)
+  checkmate::assert_flag(split_col_vars)
+  checkmate::assert_flag(do_summarize_row_groups)
 
   # Automatic assignment of formats
   if (is.null(.formats)) {
@@ -113,19 +141,6 @@ analyze_vars_in_cols <- function(lyt,
     formats_v <- .formats
   }
 
-  afun_list <- Map(
-    function(stat) {
-      make_afun(
-        s_summary,
-        .labels = labelstr,
-        .stats = stat,
-        .format_na_strs = na_level,
-        .formats = formats_v[names(formats_v) == stat]
-      )
-    },
-    stat = .stats
-  )
-
   # Check for vars in the case that one or more are used
   if (length(vars) == 1) {
     vars <- rep(vars, length(.stats))
@@ -136,15 +151,129 @@ analyze_vars_in_cols <- function(lyt,
     )
   }
 
-  lyt <- split_cols_by_multivar(
-    lyt = lyt,
-    vars = vars,
-    varlabels = .labels[.stats]
-  )
-
-  analyze_colvars(lyt,
-    afun = afun_list,
-    nested = nested,
-    extra_args = list(...)
-  )
+  if (split_col_vars) {
+    # Checking there is not a previous identical column split
+    clyt <- tail(clayout(lyt), 1)[[1]]
+
+    dummy_lyt <- split_cols_by_multivar(
+      lyt = basic_table(),
+      vars = vars,
+      varlabels = .labels[.stats]
+    )
+
+    if (any(sapply(clyt, identical, y = get_last_col_split(dummy_lyt)))) {
+      stop(
+        "Column split called again with the same values. ",
+        "This can create many unwanted columns. Please consider adding ",
+        "split_col_vars = FALSE to the last call of ",
+        deparse(sys.calls()[[sys.nframe() - 1]]), "."
+      )
+    }
+
+    # Main col split
+    lyt <- split_cols_by_multivar(
+      lyt = lyt,
+      vars = vars,
+      varlabels = .labels[.stats]
+    )
+  }
+
+  if (do_summarize_row_groups) {
+    if (length(unique(vars)) > 1) {
+      stop("When using do_summarize_row_groups only one label level var should be inserted.")
+    }
+
+    # Function list for do_summarize_row_groups. Slightly different handling of labels
+    cfun_list <- Map(
+      function(stat) {
+        function(u, .spl_context, labelstr, ...) {
+          # Statistic
+          res <- s_summary(u, ...)[[stat]]
+
+          # Label check and replacement
+          if (length(row_labels) > 1) {
+            if (!(labelstr %in% names(row_labels))) {
+              stop("Replacing the labels in do_summarize_row_groups needs a named vector",
+                   "that contains the split values. In the current split variable ",
+                   .spl_context$split[nrow(.spl_context)],
+                   " the labelstr value (split value by default) ", labelstr, " is not in",
+                   " row_labels names: ", names(row_labels))
+            }
+            lbl <- unlist(row_labels[labelstr])
+          } else {
+            lbl <- labelstr
+          }
+
+          # Cell creation
+          rcell(res,
+                label = lbl,
+                format = formats_v[names(formats_v) == stat][[1]],
+                format_na_str = na_level,
+                indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods)
+          )
+        }
+      },
+      stat = .stats
+    )
+
+    # Main call to rtables
+    summarize_row_groups(
+      lyt = lyt,
+      var = unique(vars),
+      cfun = cfun_list,
+      extra_args = list(...)
+    )
+  } else {
+    # Function list for analyze_colvars
+    afun_list <- Map(
+      function(stat) {
+        function(u, .spl_context, ...) {
+          # Main statistics
+          res <- s_summary(u, ...)[[stat]]
+
+          # Label from context
+          label_from_context <- .spl_context$value[nrow(.spl_context)]
+
+          # Label switcher
+          if (is.null(row_labels)) {
+            lbl <- label_from_context
+          } else {
+            if (length(row_labels) > 1) {
+              if (!(label_from_context %in% names(row_labels))) {
+                stop("Replacing the labels in do_summarize_row_groups needs a named vector",
+                     "that contains the split values. In the current split variable ",
+                     .spl_context$split[nrow(.spl_context)],
+                     " the split value ", label_from_context, " is not in",
+                     " row_labels names: ", names(row_labels))
+              }
+              lbl <- unlist(row_labels[label_from_context])
+            }
+          }
+
+          # Cell creation
+          rcell(res,
+                label = lbl,
+                format = formats_v[names(formats_v) == stat][[1]],
+                format_na_str = na_level,
+                indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods)
+          )
+        }
+      },
+      stat = .stats
+    )
+
+    # Main call to rtables
+    analyze_colvars(lyt,
+      afun = afun_list,
+      nested = nested,
+      extra_args = list(...)
+    )
+  }
+}
+
+# TODO: multiple analyze calls WITHOUT the row split
+
+# Help function
+get_last_col_split <- function(lyt) {
+  tail(tail(clayout(lyt), 1)[[1]], 1)[[1]]
 }

R/argument_convention.R

@@ -32,7 +32,8 @@
 #'   all of that structure's children. Defaults to 0, which corresponds to the
 #'   unmodified default behavior.
 #' @param labelstr (`character`)\cr label of the level of the parent split currently being summarized
-#'   (must be present as second argument in Content Row Functions).
+#'   (must be present as second argument in Content Row Functions). See [rtables::summarize_row_groups()]
+#'   for more information.
 #' @param lyt (`layout`)\cr input layout where analyses will be added to.
 #' @param na.rm (`flag`)\cr whether `NA` values should be removed from `x` prior to analysis.
 #' @param na_level (`string`)\cr used to replace all `NA` or empty values in factors with custom `string`.

R/survival_timepoint.R

@@ -339,6 +339,7 @@ surv_timepoint <- function(lyt,
         var_labels = paste(tpt, var_labels),
         table_names = paste0("surv_diff_", tpt, table_names_suffix),
         show_labels = ifelse(method == "both", "hidden", show_labels),
+        indent_mod = ifelse(method == "both", 1L, 0L),
         afun = afun_surv_diff,
         extra_args = list(
           is_event = list(...)$is_event,