761 better getter seeters@221 fix separator div@main (#782)

* update ref_group column ordering * testing formatter issue #221 * minor changes and fixes * update, getting closer * init setter getter * More info * renamings * Update NEWS.md Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * reverting the concept of section div from layout perspective * Fixed reversion + benefits * almost there * update, revisions * documenting * final touch * minors, docs * adding 1 * Fix * styling * fix for vignette * small error fix * fixing minor docs * fix integration * fixing docs * Update R/tree_accessors.R Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * Update R/tree_accessors.R Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * Update R/tree_accessors.R Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * Update R/tree_accessors.R Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * Update R/tree_accessors.R Co-authored-by: Emily de la Rua <[email protected]> Signed-off-by: Davide Garolini <[email protected]> * roxygenizing --------- Signed-off-by: Davide Garolini <[email protected]> Signed-off-by: Davide Garolini <[email protected]> Co-authored-by: Liming Li <[email protected]> Co-authored-by: Emily de la Rua <[email protected]> Co-authored-by: Emily de la Rua <[email protected]>
insightsengineering · Nov 24, 2023 · 9b4409e · 9b4409e
1 parent 3de3da7
commit 9b4409e
Show file tree

Hide file tree

Showing 19 changed files with 945 additions and 159 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -12,12 +12,14 @@ export("col_total<-")
 export("colcount_format<-")
 export("content_table<-")
 export("fnotes_at_path<-")
+export("header_section_div<-")
 export("horizontal_sep<-")
 export("indent_mod<-")
 export("label_at_path<-")
 export("ref_index<-")
 export("ref_symbol<-")
 export("row_footnotes<-")
+export("section_div<-")
 export("top_left<-")
 export("tree_children<-")
 export("tt_at_path<-")
@@ -92,6 +94,7 @@ export(find_degen_struct)
 export(format_rcell)
 export(get_formatted_cells)
 export(head)
+export(header_section_div)
 export(horizontal_sep)
 export(import_from_tsv)
 export(in_rows)
@@ -144,6 +147,7 @@ export(rrowl)
 export(rtable)
 export(rtablel)
 export(sanitize_table_struct)
+export(section_div)
 export(section_properties_landscape)
 export(section_properties_portrait)
 export(select_all_levels)

diff --git a/NEWS.md b/NEWS.md
@@ -1,14 +1,24 @@
 ## rtables 0.6.5.9013
 ### New Features
  * Removed `ref_group` reordering in column splits so not to change the order.
- * Added `bold` argument to `as_html` to bold specified elements, and `header_sep_line` argument to print a horizontal line under the table header in rendered HTML output.
+ * Added `bold` argument to `as_html` to bold specified elements, and `header_sep_line` 
+   argument to print a horizontal line under the table header in rendered HTML output.
  * Duplicate referential footnotes are consolidated when tables are rendered.
+ * Section divisors can be set for analysis rows.
+ * Added setter and getter for section dividers (`section_div` and `section_div<-`). They also accept
+   split section structure assignment.
+ * Added `header_section_div` setters and getters for layout and table objects along with 
+   related `basic_table` parameter.
+
+### Bug Fixes
+ * Fixed a bug that was failing when wrapping and section dividers were used at the same time.
 
 ### Miscellaneous
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.
  * Added Developer Guide to pkgdown site with Debugging, Split Machinery, and Tabulation sections.
  * Whitespace is not trimmed when rendering tables with `as_html`.
  * Started deprecation cycle for `col_fnotes_here` to be replaced with `col_footnotes`.
+ * Exported `section_div` methods now have a dedicated documentation page that is visible to users.
 
 ## rtables 0.6.5
 ### New Features

diff --git a/R/00tabletrees.R b/R/00tabletrees.R
@@ -1,5 +1,4 @@
-## Split types
-## -----------
+## Split types -----------------------------------------------------------------
 ## variable: split on distinct values of a variable
 ## all: include all observations (root 'split')
 ## rawcut: cut on static values of a variable
@@ -647,7 +646,8 @@ AnalyzeVarSplit <- function(var,
                             extra_args = list(),
                             indent_mod = 0L,
                             label_pos = "default",
-                            cvar = "") {
+                            cvar = "",
+                            section_div = NA_character_) {
   check_ok_label(split_label)
   label_pos <- match.arg(label_pos, c("default", label_pos_values))
   if (!any(nzchar(defrowlab))) {
@@ -674,7 +674,7 @@ AnalyzeVarSplit <- function(var,
     var_label_position = label_pos,
     content_var = cvar,
     page_title_prefix = NA_character_,
-    child_section_div = NA_character_
+    child_section_div = section_div
   ) ## no content_extra_args
 }
 
@@ -696,7 +696,8 @@ AnalyzeColVarSplit <- function(afun,
                                extra_args = list(),
                                indent_mod = 0L,
                                label_pos = "default",
-                               cvar = "") {
+                               cvar = "",
+                               section_div = NA_character_) {
   label_pos <- match.arg(label_pos, c("default", label_pos_values))
   new("AnalyzeColVarSplit",
     payload = NA_character_,
@@ -716,7 +717,7 @@ AnalyzeColVarSplit <- function(afun,
     var_label_position = label_pos,
     content_var = cvar,
     page_title_prefix = NA_character_,
-    child_section_div = NA_character_
+    child_section_div = section_div
   ) ## no content_extra_args
 }
 
@@ -828,7 +829,8 @@ AnalyzeMultiVars <- function(var,
         indent_mod = indent_mod,
         label_pos = show_kidlabs,
         split_format = split_format,
-        split_na_str = split_na_str
+        split_na_str = split_na_str,
+        section_div = section_div
       ), ## rvis),
       SIMPLIFY = FALSE
     )
@@ -1015,8 +1017,7 @@ make_child_pos <- function(parpos,
 }
 
 
-###
-### Virtual Classes
+# Virtual Classes for Tree Nodes and Layouts =================================
 ###
 ### Virtual class hiearchy for the various types of
 ### trees in use in the S4 implementation of the TableTree
@@ -1148,7 +1149,7 @@ LayoutColLeaf <- function(lev = 0L,
 
 
 
-## Instantiated column info class
+## Instantiated column info class ==============================================
 ##
 ## This is so we don't need multiple arguments
 ## in the recursive functions that track
@@ -1236,10 +1237,7 @@ InstantiatedColumnInfo <- function(treelyt = LayoutColTree(),
 }
 
 
-
-
-
-## TableTrees
+## TableTrees and row classes ==================================================
 ## XXX Rowspans as implemented dont really work
 ## they're aren't attached to the right data structures
 ## during conversions.
@@ -1264,7 +1262,8 @@ setClass("TableRow",
     var_analyzed = "character",
     ##         var_label = "character",
     label = "character",
-    row_footnotes = "list"
+    row_footnotes = "list",
+    trailing_section_div = "character"
   )
 )
 
@@ -1286,7 +1285,8 @@ LabelRow <- function(lev = 1L,
                      vis = !is.na(label) && nzchar(label),
                      cinfo = EmptyColInfo,
                      indent_mod = 0L,
-                     table_inset = 0L) {
+                     table_inset = 0L,
+                     trailing_section_div = NA_character_) {
   check_ok_label(label)
   new("LabelRow",
     leaf_value = list(),
@@ -1299,7 +1299,8 @@ LabelRow <- function(lev = 1L,
     col_info = cinfo,
     visible = vis,
     indent_modifier = as.integer(indent_mod),
-    table_inset = as.integer(table_inset)
+    table_inset = as.integer(table_inset),
+    trailing_section_div = trailing_section_div
   )
 }
 
@@ -1353,7 +1354,8 @@ setClass("LabelRow",
                       klass,
                       indent_mod = 0L,
                       footnotes = list(),
-                      table_inset = 0L) {
+                      table_inset = 0L,
+                      trailing_section_div = NA_character_) {
   if ((missing(name) || is.null(name) || is.na(name) || nchar(name) == 0) && !missing(label)) {
     name <- label
   }
@@ -1380,7 +1382,8 @@ setClass("LabelRow",
     na_str = NA_character_,
     indent_modifier = indent_mod,
     row_footnotes = footnotes,
-    table_inset = table_inset
+    table_inset = table_inset,
+    trailing_section_div = trailing_section_div
   )
   rw <- set_format_recursive(rw, format, na_str, FALSE)
   rw
@@ -1413,6 +1416,7 @@ setClass("VTableTree",
     labelrow = "LabelRow",
     page_titles = "character",
     horizontal_sep = "character",
+    header_section_div = "character",
     trailing_section_div = "character"
   )
 )
@@ -1516,8 +1520,9 @@ ElementaryTable <- function(kids = list(),
                             subtitles = character(),
                             main_footer = character(),
                             prov_footer = character(),
+                            header_section_div = NA_character_,
                             hsep = default_hsep(),
-                            trailing_sep = NA_character_,
+                            trailing_section_div = NA_character_,
                             inset = 0L) {
   check_ok_label(label)
   if (is.null(cinfo)) {
@@ -1551,7 +1556,8 @@ ElementaryTable <- function(kids = list(),
     main_footer = main_footer,
     provenance_footer = prov_footer,
     horizontal_sep = hsep,
-    trailing_section_div = trailing_sep
+    header_section_div = header_section_div,
+    trailing_section_div = trailing_section_div
   )
   tab <- set_format_recursive(tab, format, na_str, FALSE)
   table_inset(tab) <- as.integer(inset)
@@ -1615,7 +1621,8 @@ TableTree <- function(kids = list(),
                       prov_footer = character(),
                       page_title = NA_character_,
                       hsep = default_hsep(),
-                      trailing_sep = NA_character_,
+                      header_section_div = NA_character_,
+                      trailing_section_div = NA_character_,
                       inset = 0L) {
   check_ok_label(label)
   cinfo <- .calc_cinfo(cinfo, cont, kids)
@@ -1648,7 +1655,8 @@ TableTree <- function(kids = list(),
       main_footer = main_footer,
       prov_footer = prov_footer,
       hsep = hsep,
-      trailing_sep = trailing_sep,
+      header_section_div = header_section_div,
+      trailing_section_div = trailing_section_div,
       inset = inset
     )
   } else {
@@ -1670,12 +1678,13 @@ TableTree <- function(kids = list(),
       provenance_footer = prov_footer,
       page_title_prefix = page_title,
       horizontal_sep = "-",
-      trailing_section_div = trailing_sep
+      header_section_div = header_section_div,
+      trailing_section_div = trailing_section_div
     ) ## this is overridden below to get recursiveness
     tab <- set_format_recursive(tab, format, na_str, FALSE)
 
     ## these is recursive
-    ## XXX combine thse probably
+    ## XXX combine these probably
     horizontal_sep(tab) <- hsep
     table_inset(tab) <- as.integer(inset)
     tab
@@ -1796,6 +1805,7 @@ setClass("PreDataTableLayouts",
     row_layout = "PreDataRowLayout",
     col_layout = "PreDataColLayout",
     top_left = "character",
+    header_section_div = "character",
     table_inset = "integer"
   )
 )
@@ -1807,6 +1817,7 @@ PreDataTableLayouts <- function(rlayout = PreDataRowLayout(),
                                 subtitles = character(),
                                 main_footer = character(),
                                 prov_footer = character(),
+                                header_section_div = NA_character_,
                                 table_inset = 0L) {
   new("PreDataTableLayouts",
     row_layout = rlayout,
@@ -1816,6 +1827,7 @@ PreDataTableLayouts <- function(rlayout = PreDataRowLayout(),
     subtitles = subtitles,
     main_footer = main_footer,
     provenance_footer = prov_footer,
+    header_section_div = header_section_div,
     table_inset = table_inset
   )
 }

diff --git a/R/argument_conventions.R b/R/argument_conventions.R
@@ -219,20 +219,24 @@ lyt_args <- function(lyt, var, vars, label, labels_var, varlabels, varnames, spl
 #'   Generally should not be modified by hand.
 #' @param footnotes list or NULL. Referential footnotes to be applied at current
 #'   level. In post-processing, this can be achieved with [`fnotes_at_path<-`].
-#' @param trailing_sep character(1). String which will be used as a section
+#' @param trailing_section_div character(1). String which will be used as a section
 #'   divider after the printing of the last row contained in this (sub)-table,
 #'   unless that row is also the last table row to be printed overall, or
 #'   `NA_character_` for none (the default). When generated via layouting, this
 #'   would correspond to the `section_div` of the split under which this table
 #'   represents a single facet.
+#' @param header_section_div character(1). String which will be used to divide the header
+#'   from the table. See [header_section_div()] for getter and setter of these.
+#'   Please consider changing last element of [section_div()] when concatenating 
+#'   tables that need a divider between them.
 #' @param page_title character. Page specific title(s).
 #' @rdname constr_args
 constr_args <- function(kids, cont, lev, iscontent, cinfo, labelrow, vals,
                         cspan, label_pos, cindent_mod, cvar, label, cextra_args,
                         child_names, title, subtitles, main_footer, prov_footer,
                         footnotes, page_title, page_prefix, section_div,
-                        trailing_sep, split_na_str,
-                        cna_str, inset, table_inset) {
+                        trailing_section_div, split_na_str,
+                        cna_str, inset, table_inset, header_section_div) {
   NULL
 }
 

diff --git a/R/colby_constructors.R b/R/colby_constructors.R
@@ -2049,18 +2049,21 @@ basic_table <- function(title = "",
                         subtitles = character(),
                         main_footer = character(),
                         prov_footer = character(),
+                        header_section_div = NA_character_,
                         show_colcounts = FALSE,
                         colcount_format = "(N=xx)",
                         inset = 0L) {
   inset <- as.integer(inset)
   if (is.na(inset) || inset < 0L) {
     stop("Got invalid table_inset value, must be an integer > 0")
   }
+  .check_header_section_div(header_section_div)
   ret <- PreDataTableLayouts(
     title = title,
     subtitles = subtitles,
     main_footer = main_footer,
     prov_footer = prov_footer,
+    header_section_div = header_section_div,
     table_inset = as.integer(inset)
   )
   if (show_colcounts) {