Fix section_div in case of multiple var analyzed (`AnalyzeMultiVars…

…`) (#836)

* Fixing section div

* [skip style] [skip vbump] Restyle files

* other test

* [skip style] [skip vbump] Restyle files

* empty

---------

Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>

NEWS.md

@@ -9,6 +9,7 @@
  * Fixed issue with `rtables_root` not being removed when using `as_result_df`.
  * Fixed edge case bug in `as_result_df` where rows of the table have only `"root"` as path index.
  * Fixed `sort_at_path` pathing to ignore leading `"root"` element (regardless of actual root element name) to match current `tt_at_path` behavior.
+ * Fixed `section_div` for analysis of multiple variables (`AnalyzeMultiVars`).
 
 ## rtables 0.6.6
 ### New Features

R/00tabletrees.R

@@ -814,6 +814,7 @@ AnalyzeMultiVars <- function(var,
     cformat <- .repoutlst(cformat, nv)
     ##        split_format = .repoutlst(split_format, nv)
     inclNAs <- .repoutlst(inclNAs, nv)
+    section_div_if_multivar <- if (length(var) > 1) NA_character_ else section_div
     pld <- mapply(AnalyzeVarSplit,
       var = var,
       split_name = child_names,
@@ -830,7 +831,7 @@ AnalyzeMultiVars <- function(var,
         label_pos = show_kidlabs,
         split_format = split_format,
         split_na_str = split_na_str,
-        section_div = section_div
+        section_div = section_div_if_multivar
       ), ## rvis),
       SIMPLIFY = FALSE
     )

R/tt_dotabulation.R

@@ -692,6 +692,8 @@ setMethod(
       ...
     ))
 
+    kids <- .set_kids_section_div(kids, spl_section_div(spl), "VTableTree")
+
     ## XXX this seems like it should be identical not !identical
     ## TODO FIXME
     if (!identical(make_lrow, FALSE) && !have_controws && length(kids) == 1) {

R/utils.R

@@ -108,7 +108,7 @@ paste_vec <- function(vec) {
 # Utility for checking if a package is installed
 check_required_packages <- function(pkgs) {
   for (pkgi in pkgs) {
-    if (!requireNamespace(pkgi)) {
+    if (!requireNamespace(pkgi, quietly = TRUE)) {
       stop(
         "This function requires the ", pkgi, " package. ",
         "Please install it if you wish to use it"

tests/testthat/setup-fakedata.R

@@ -223,3 +223,10 @@ tt_for_nl <- tt_to_test_newline_chars()
     nchar(str) - nchar(gsub(chr, "", str, fixed = TRUE))
   }
 }
+
+# Utility function for section_div tests
+check_pattern <- function(element, letter, len) {
+  # Regular expression to match exactly len of the same letter
+  regex <- paste0(rep(letter, len), collapse = "")
+  return(grepl(regex, element, fixed = TRUE))
+}

tests/testthat/test-accessors.R

@@ -225,12 +225,6 @@ test_that("header sep setting works", {
 })
 
 # section_div tests ------------------------------------------------------------
-check_pattern <- function(element, letter, len) {
-  # Regular expression to match exactly len of the same letter
-  regex <- paste0(rep(letter, len), collapse = "")
-  return(grepl(regex, element, fixed = TRUE))
-}
-
 test_structure_with_a_getter <- function(tbl, getter, val_per_lev) {
   # Main table obj
   expect_identical(tbl %>% getter(), val_per_lev$global)

tests/testthat/test-exporters.R

@@ -390,7 +390,7 @@ test_that("Can create flextable object that works with different styles", {
 
   # internal package check
   not_a_pkg <- "bwrereloakdosirabttjtaeerr"
-  suppressMessages(expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg))
+  expect_error(check_required_packages(c("flextable", not_a_pkg)), not_a_pkg)
 })
 
 test_that("export_as_doc works thanks to tt_to_flextable", {

tests/testthat/test-printing.R

@@ -397,6 +397,34 @@ test_that("section_div works throughout", {
   expect_identical(length(mylns), 31L) ## sect div not printed for last one
 })
 
+test_that("section_div works when analyzing multiple variables", {
+  # Regression test for #835
+  lyt <- basic_table() %>%
+    split_rows_by("Species", section_div = "|") %>%
+    analyze(c("Petal.Width", "Petal.Length"),
+      afun = function(x) list("m" = mean(x), "sd" = sd(x)), section_div = "-"
+    )
+
+  tbl <- build_table(lyt, iris)
+  out <- strsplit(toString(tbl), "\n")[[1]]
+
+  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]]
+
+  expect_true(check_pattern(out[7], "|", length(out[1])))
+  expect_true(check_pattern(out[10], "-", length(out[1])))
+})
+
 test_that("Inset works for table, ref_footnotes, and main footer", {
   general_inset <- 3