child_labels="hidden" no longer affects tbl structure (#314). dev vbump

insightsengineering · Apr 5, 2022 · c896802 · c896802
1 parent e4626c5
commit c896802
Show file tree

Hide file tree

Showing 4 changed files with 57 additions and 5 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: rtables
 Title: Reporting Tables
 Date: 2022-3-31
-Version: 0.5.0
+Version: 0.5.0.1
 Authors@R: c(
   person("Gabriel", "Becker", email = "gabembecker@gmail.com", role = c("aut", "cre")),
   person("Adrian", "Waddell", email = "adrian.waddell@roche.com", role = "aut"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+## rtables 0.5.0.1
+ * `split_rows_by(var, child_labels="hidden")` no longer removes the structural subtable corresponding to levels of `var` (#314)
+
 ## rtables 0.5.0
  * `formatable` dependency renamed to `formatters` for suitability of release to CRAN
  * Update versioned dependency of `formatters` (previously `formatable`) to `>=0.2.0` 

diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R
@@ -703,7 +703,8 @@ recursive_applysplit = function( df,
                                 cvar = NULL,
                                 baselines = lapply(col_extra_args(cinfo),
                                                    function(x) x$.ref_full),
-                                spl_context = context_df_row(cinfo = cinfo)) {
+                                spl_context = context_df_row(cinfo = cinfo),
+                                no_outer_tbl = FALSE) {
     ## pre-existing table was added to the layout
     if(length(splvec) == 1L && is(splvec[[1]], "VTableNodeInfo"))
         return(splvec[[1]])
@@ -764,10 +765,14 @@ recursive_applysplit = function( df,
     if(make_lrow && partlabel == "" && !nonroot)
         make_lrow = FALSE
 
-    if(nrow(ctab) == 0L && length(kids) == 1L && !make_lrow) {
+    ## this is only true when called from build_table and the first split
+    ## in (one of the) SplitVector is NOT an AnalyzeMultiVars split.
+    ## in that case we would be "double creating" the structural
+    ## subtable
+    if(no_outer_tbl) {
         ret = kids[[1]]
         indent_mod(ret) = indent_mod(spl)
-     } else if(nrow(ctab) > 0L || length(kids) > 0L) {
+    } else if(nrow(ctab) > 0L || length(kids) > 0L) {
          ## previously we checked if the child had an identical label
          ## but I don't think tahts needed anymore.
          tlabel = partlabel
@@ -945,7 +950,9 @@ build_table = function(lyt, df,
                              cformat = content_format(firstspl),
                              cvar = content_var(firstspl),
                              cextra_args = content_extra_args(firstspl),
-                             spl_context = context_df_row(cinfo = cinfo))
+                             spl_context = context_df_row(cinfo = cinfo),
+                             ## we DO want the 'outer table' if the first one is a multi-analyze
+                             no_outer_tbl = !is(firstspl, "AnalyzeMultiVars"))
     })
     kids = kids[!sapply(kids, is.null)]
     if(length(kids) > 0)

diff --git a/tests/testthat/test-regressions.R b/tests/testthat/test-regressions.R
@@ -441,3 +441,45 @@ test_that("specifying function format with no cfun in summarize_row_groups works
     mat <- matrix_form(tbl)
     expect_identical(mat$strings[4, 2, drop = TRUE], "0")
 })
+
+## https://github.com/Roche/rtables/issues/314
+test_that("child_label = hidden does not affect tree structure/pathing", {
+
+    df <- expand.grid(
+        ARM = factor(paste("ARM", c("A", "B"))),
+        FCT = factor(c("f1", "f2"))
+    )
+    df <- cbind(df, val = 1:NROW(df))
+
+    df
+
+    s_test <- function(df, ...) in_rows(mn = 1, sd = 2)
+
+    lyt <- basic_table() %>%
+        split_cols_by("ARM", ref_group = "ARM A") %>%
+        split_rows_by("FCT", child_labels = "hidden") %>%
+        analyze("val", afun = s_test)
+
+    tbl <- build_table(lyt, df)
+
+    lyt2 <-  basic_table() %>%
+        split_cols_by("ARM", ref_group = "ARM A") %>%
+        split_rows_by("FCT") %>%
+        analyze("val", afun = s_test)
+
+    tbl2 <- build_table(lyt2, df)
+
+    rdf1 <- make_row_df(tbl)
+    rdf2 <- make_row_df(tbl2)
+    expect_identical(row_paths(tbl),
+                     row_paths(tbl2)[-c(1,4)])
+
+    expect_identical(make_row_df(tbl, visible_only = FALSE)$path,
+                     make_row_df(tbl2, visible_only = FALSE)$path[-c(2,7)])
+
+    expect_identical(value_at(tbl, c("FCT", "f1", "val", "mn"), c("ARM", "ARM A")),
+                     1)
+    expect_identical(value_at(tbl2, c("FCT", "f1", "val", "mn"), c("ARM", "ARM A")),
+                     1)
+
+})