Merge 0917561 into 12b8b42

insightsengineering · Jun 9, 2023 · ac48f23 · ac48f23
2 parents 12b8b42 + 0917561
commit ac48f23
Show file tree

Hide file tree

Showing 3 changed files with 42 additions and 13 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -4,6 +4,7 @@
 * Added explicit zero counts to `g_km` plot "at risk" annotation tables.
 * Added a flag for total level split in `analyze_patients_exposure_in_cols`.
 * Implemented `.indent_mods` argument in functions `h_tab_one_biomarker`, `h_tab_rsp_one_biomarker`, `h_tab_surv_one_biomarker`, `summarize_logistic`, `logistic_summary_by_flag`, `tabulate_rsp_biomarkers`, a_coxreg, `summarize_coxreg`, `tabulate_survival_biomarkers`, `surv_time`, `surv_timepoint`, and `cfun_by_flag`.
+* Updated `summarize_coxreg` to print covariates in data rows for univariate Cox regression with no interactions and content rows otherwise.
 
 ### Bug Fixes
 * Fixed bug in `split_text_grob` preventing titles and footnotes from being properly formatted and printed by `decorate_grob`.

diff --git a/R/summarize_coxreg.R b/R/summarize_coxreg.R
@@ -190,7 +190,11 @@ a_coxreg <- function(df,
   cov_no_arm <- !multivar && !"arm" %in% names(variables) && control$interaction # special case: univar no arm
   cov <- tail(.spl_context$value, 1) # current variable/covariate
   var_lbl <- formatters::var_labels(df)[cov] # check for df labels
-  if (!is.na(var_lbl) && labelstr == cov && cov %in% variables$covariates) labelstr <- var_lbl # use df labels if none
+  if (length(labelstr) > 1) {
+    labelstr <- if (cov %in% names(labelstr)) labelstr[[cov]] else var_lbl # use df labels if none
+  } else if (!is.na(var_lbl) && labelstr == cov && cov %in% variables$covariates) {
+    labelstr <- var_lbl
+  }
   if (eff || multivar || cov_no_arm) {
     control$interaction <- FALSE
   } else {
@@ -374,7 +378,7 @@ summarize_coxreg <- function(lyt,
       lyt <- lyt %>%
         analyze_colvars(
           afun = a_coxreg,
-          extra_args = list(eff = TRUE, control = control, variables = variables, multivar = multivar)
+          extra_args = list(eff = TRUE, control = control, variables = variables, multivar = multivar, labelstr = "")
         )
     }
   }
@@ -386,15 +390,31 @@ summarize_coxreg <- function(lyt,
         varlabels = varlabels,
         split_label = "Covariate:",
         nested = FALSE,
+        child_labels = if (multivar || control$interaction || !"arm" %in% names(variables)) "default" else "hidden",
         section_div = tail(.section_div, 1)
-      ) %>%
-      summarize_row_groups(
-        cfun = a_coxreg,
-        extra_args = list(
-          variables = variables, at = at, control = control, multivar = multivar,
-          var_main = if (multivar) multivar else control$interaction
-        )
       )
+    if (multivar || control$interaction || !"arm" %in% names(variables)) {
+      lyt <- lyt %>%
+        summarize_row_groups(
+          cfun = a_coxreg,
+          extra_args = list(
+            variables = variables, at = at, control = control, multivar = multivar,
+            var_main = if (multivar) multivar else control$interaction
+          )
+        )
+    } else {
+      if (!is.null(varlabels)) names(varlabels) <- variables$covariates
+      lyt <- lyt %>%
+        analyze_colvars(
+          afun = a_coxreg,
+          extra_args = list(
+            variables = variables, at = at, control = control, multivar = multivar,
+            var_main = if (multivar) multivar else control$interaction,
+            labelstr = if (is.null(varlabels)) "" else varlabels
+          )
+        )
+    }
+
     if (!"arm" %in% names(variables)) control$interaction <- TRUE # special case: univar no arm
     if (multivar || control$interaction) { # covariate level effects
       lyt <- lyt %>%

diff --git a/tests/testthat/test-summarize_coxreg.R b/tests/testthat/test-summarize_coxreg.R
@@ -67,12 +67,12 @@ testthat::test_that("a_coxreg works as expected", {
 # summarize_coxreg ----
 
 testthat::test_that("summarize_coxreg adds the univariate Cox regression layer to rtables", {
-  lyt <- basic_table() %>%
+  result <- basic_table() %>%
     summarize_coxreg(
       variables = variables,
       control = control_coxreg(ties = "breslow", conf_level = 0.90)
-    )
-  result <- lyt %>% build_table(df = dta_bladder)
+    ) %>%
+    build_table(df = dta_bladder)
 
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
@@ -90,10 +90,18 @@ testthat::test_that("summarize_coxreg adds the univariate Cox regression layer t
 
   # no labels
   formatters::var_labels(dta_bladder) <- rep(NA_character_, ncol(dta_bladder))
-  result <- lyt %>% build_table(df = dta_bladder)
+  result <- basic_table() %>%
+    summarize_coxreg(
+      variables = variables,
+      control = control_coxreg(ties = "breslow", conf_level = 0.90)
+    ) %>%
+    build_table(df = dta_bladder)
 
   res <- testthat::expect_silent(result)
   testthat::expect_snapshot(res)
+
+  # pagination
+  testthat::expect_silent(pag_result <- paginate_table(result, lpp = 10))
 })
 
 testthat::test_that("summarize_coxreg .section_div argument works", {