fix every row sep behavior of analyze section_div (#996)

This is technically a breaking change, but one we all agree on as far as
I understand.

`section_div` in `analyze` will now always apply to analyze blocks and
never apply to each row generated by the analyze

tests are updated to reflect the new behavior

---------

Signed-off-by: Davide Garolini <[email protected]>
Signed-off-by: Joe Zhu <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Melkiades <[email protected]>
Co-authored-by: Joe Zhu <[email protected]>

NEWS.md

@@ -7,8 +7,9 @@
 ### Bug Fixes
  * Fixed issue with `split_cols_by_multivar()` when having more than one value. Now `as_result_df(make_ard = TRUE)` adds a predefined split name for each of the `multivar` splits.
  * Fixed bug happening when format functions were changing the number of printed values. Now `as_result_df(make_ard = TRUE)` uses the cell values for `stat_strings` for these exceptions.
+ * `section_div` argument to `analyze` no longer sometimes applies dividers between each generated row in some cases. by @gmbecker
  * Fixed bug in `[<-` causing information to be stripped from other cells if a new `rcell` is set within a table row.
- 
+
 ## rtables 0.6.11
 
 ### New Features

R/colby_constructors.R

@@ -1048,6 +1048,11 @@ NULL
 #' the tabulation will occur at the current/next level of nesting by default.
 #'
 #' @inheritParams lyt_args
+#' @param section_div (`string`)\cr string which should be repeated as a section divider after the set of rows  defined
+#'   by (each sub-analysis/variable) of this analyze instruction, or
+#'   `NA_character_` (the default) for no section divider. This section
+#'   divider will be overridden by a split-level section divider when
+#'   both apply to the same position in the rendered output.
 #'
 #' @inherit split_cols_by return
 #'

R/tree_accessors.R

@@ -4102,11 +4102,18 @@ setMethod("section_div<-", "VTableTree", function(obj, only_sep_sections = FALSE
     } else {
       # All leaves are modified
       trailing_section_div(tt_labelrow(obj)) <- char_v[1]
-      trailing_section_div(obj) <- NA_character_
       section_div(tree_children(obj), only_sep_sections = only_sep_sections) <- char_v[-1]
+      if (are(tree_children(obj), "TableRow")) {
+        trailing_section_div(obj) <- tail(char_v, 1)
+      } else {
+        trailing_section_div(obj) <- NA_character_
+      }
     }
   } else {
     section_div(tree_children(obj), only_sep_sections = only_sep_sections) <- char_v
+    if (are(tree_children(obj), "TableRow")) {
+      trailing_section_div(obj) <- tail(char_v, 1)
+    }
   }
   obj
 })

R/tt_dotabulation.R

@@ -569,7 +569,7 @@ gen_rowvalues <- function(dfpart,
   )
 
   # Adding section_div for DataRows (analyze leaves)
-  kids <- .set_kids_section_div(kids, spl_section_div(spl), "DataRow")
+  # kids <- .set_kids_section_div(kids, spl_section_div(spl), "DataRow")
 
   if (is(kids, "error")) {
     stop("Error applying analysis function (var - ",
@@ -588,7 +588,8 @@ gen_rowvalues <- function(dfpart,
     cinfo = cinfo,
     format = obj_format(spl),
     na_str = obj_na_str(spl),
-    indent_mod = indent_mod(spl)
+    indent_mod = indent_mod(spl),
+    trailing_section_div = spl_section_div(spl)
   )
 
   labelrow_visible(ret) <- dolab

inst/WORDLIST

@@ -1,42 +1,13 @@
+amongst
 ARD
 ARDs
 Bové
-CRAN's
 Carreras
+charset
 Cheatsheet
 Chohan
-FFFL
-Godwin
-Heng
-Hoffmann
-Kelkhoff
-Layouting
-Lewandowski
-Maximo
-Modelling
-NSE
-ORCID
-Paszty
-Pharma
-Phuse
-Pre
-Qi
-RStudio
-Resync
-Rua
-STUDYID
-Sabanés
-Saibah
-Stoilova
-Subtable
-Subtables
-Tadeusz
-Unstratified
-ValueWrapper
-Yung
-amongst
-charset
 combinatorial
+CRAN's
 customizations
 de
 decrementing
@@ -45,49 +16,80 @@ dplyr
 emph
 facetted
 facetting
+FFFL
 formatter
 forseeable
 funder
 getter
 getters
+Godwin
+Heng
+Hoffmann
 ing
 initializer
 iteratively
+Kelkhoff
 labelled
+Layouting
 layouting
+Lewandowski
 mandatorily
+Maximo
+Modelling
 monospace
 multivariable
+NSE
+ORCID
 orderable
+params
+Paszty
 pathing
+Pharma
+Phuse
 postfix
 postprocessing
+Pre
 pre
 priori
 programmatically
+Qi
 reindexed
 repo
 repped
 responder
+Resync
 reusability
 roadmap
+RStudio
+rtables
+Rua
+Sabanés
+Saibah
 sortable
 spl
+Stoilova
+STUDYID
 subsplits
+Subtable
 subtable
 subtable's
+Subtables
 subtables
 summarization
 tableone
+Tadeusz
 todo
 traversable
 truetype
 unaggregated
 unicode
 univariable
 unpruned
+Unstratified
 unstratified
 useR
+ValueWrapper
 visibilty
 visiblities
 xtable
+Yung

tests/testthat/test-accessors.R

@@ -244,9 +244,9 @@ test_structure_with_a_getter <- function(tbl, getter, val_per_lev) {
     expect_identical(tree_children(content_elem_tbl)[[1]] %>% getter(), val_per_lev$contentrow)
   }
 
-  # The elementary table has it?
+  ## The elementary table has it?
   leaves_elementary_tbl <- tree_children(split1)[[1]]
-  expect_identical(leaves_elementary_tbl %>% getter(), val_per_lev$elem_tbl_labelrow)
+  expect_identical(leaves_elementary_tbl %>% getter(), val_per_lev$elem_tbl)
   expect_identical(tt_labelrow(leaves_elementary_tbl) %>% getter(), val_per_lev$elem_tbl_labelrow)
 
   # Data rows has it?
@@ -284,7 +284,8 @@ test_that("section_div getter and setter works", {
     "contentrow" = NA_character_,
     "content_labelrow" = NA_character_,
     "elem_tbl_labelrow" = NA_character_,
-    "datarow" = c(" ", " ")
+    "elem_tbl" = " ",
+    "datarow" = c(NA_character_, NA_character_)
   )
 
   # Checks of structure - precedence is top to bottom
@@ -314,6 +315,7 @@ test_that("section_div getter and setter works", {
     "contentrow" = NA_character_,
     "content_labelrow" = NA_character_,
     "elem_tbl_labelrow" = NA_character_,
+    "elem_tbl" = "c",
     "datarow" = c("b", "c")
   )
 

tests/testthat/test-printing.R

@@ -411,19 +411,49 @@ test_that("section_div works when analyzing multiple variables", {
 
   expect_true(check_pattern(out[11], "|", length(out[1])))
   expect_true(check_pattern(out[16], "-", length(out[1])))
+})
 
-  # One-var still works
-  lyt <- basic_table() %>%
-    split_rows_by("Species", section_div = "|") %>%
-    analyze("Petal.Width",
-      afun = function(x) list("m" = mean(x), "sd" = sd(x)), section_div = "-"
-    )
-
-  tbl <- build_table(lyt, iris)
-  out <- strsplit(toString(tbl), "\n")[[1]]
+## section_div passed to analyze works correctly in all cases #863
+test_that("analyze section_div works correctly", {
+  lyt1 <- basic_table() %>%
+    split_rows_by("STRATA1") %>%
+    analyze("SEX", section_div = " ")
+  tbl1 <- build_table(lyt1, ex_adsl)
+  lns <- capture.output(print(tbl1))
+  expect_equal(grep("^[[:space:]]*$", lns), c(8, 14))
+
+  ## analyze section_divs do NOT override split section_divs
+  ## this is so users can specify a divider between multi-analyze blocks
+  ## that is different than one they want between split sections
+  lyt2 <- basic_table() %>%
+    split_rows_by("STRATA1", section_div = "*") %>%
+    analyze("SEX", section_div = " ")
+  tbl2 <- build_table(lyt2, ex_adsl)
+  lns2 <- capture.output(print(tbl2))
+  expect_equal(grep("^[*]*$", lns2), c(8, 14))
 
-  expect_true(check_pattern(out[7], "|", length(out[1])))
-  expect_true(check_pattern(out[10], "-", length(out[1])))
+  lyt3 <- basic_table() %>%
+    analyze("SEX", section_div = " ") %>%
+    analyze("STRATA1")
+  tbl3 <- build_table(lyt3, ex_adsl)
+  lns3 <- capture.output(print(tbl3))
+  expect_equal(grep("^[ ]*$", lns3), 8)
+
+  lyt4 <- basic_table() %>%
+    split_rows_by("STRATA1", section_div = "*") %>%
+    analyze("SEX", section_div = " ") %>%
+    analyze("STRATA1")
+  tbl4 <- build_table(lyt4, ex_adsl)
+  lns4 <- capture.output(print(tbl4))
+  expect_equal(grep("^[[:space:]]*$", lns4), c(9, 21, 33))
+  expect_equal(grep("^[*]*$", lns4), c(14, 26))
+
+  lyt5 <- basic_table() %>%
+    split_rows_by("STRATA1", section_div = "*") %>%
+    analyze(c("SEX", "STRATA1"), section_div = " ")
+  tbl5 <- build_table(lyt5, ex_adsl)
+  lns5 <- capture.output(print(tbl5))
+  expect_identical(lns4, lns5)
 })
 
 test_that("Inset works for table, ref_footnotes, and main footer", {
@@ -748,7 +778,7 @@ test_that("Separators and wrapping work together with getter and setters", {
   mf1 <- matrix_form(tbl1)
   mf2 <- matrix_form(tbl2)
   expect_identical(mf1$row_info$trailing_sep, mf2$row_info$trailing_sep)
-  expect_identical(mf1$row_info$trailing_sep, rep(c(NA, " ", "~"), 2))
+  expect_identical(mf1$row_info$trailing_sep, rep(c(NA, NA, "~"), 2))
 
   exp1 <- c(
     "            all obs",
@@ -758,12 +788,10 @@ test_that("Separators and wrapping work together with getter and setters", {
     "thing its          ",
     "so                 ",
     "  m            8   ",
-    "                   ",
     "  m/2          5   ",
     "~~~~~~~~~~~~~~~~~~~",
     "long               ",
     "  m            2   ",
-    "                   ",
     "  m/2         1.5  "
   )