761 better getter seeters@221 fix separator div@main

NEWS.md

@@ -1,6 +1,11 @@
 ## rtables 0.6.5.9011
 ### New Features
  * Removed `ref_group` reordering in column splits so not to change the order.
+ * Section divisors can be set also for analysis rows.
+ * Added setter and getter for section dividers.
+
+### Bug Fixes
+ * Fixed a bug that was failing when wrapping and section dividers where used at the same time.
 
 ### Miscellaneous
  * Applied `styler` and resolved package lint. Changed default indentation from 4 spaces to 2.

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
@@ -1517,7 +1520,7 @@ ElementaryTable <- function(kids = list(),
                             main_footer = character(),
                             prov_footer = 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 +1554,7 @@ ElementaryTable <- function(kids = list(),
     main_footer = main_footer,
     provenance_footer = prov_footer,
     horizontal_sep = hsep,
-    trailing_section_div = trailing_sep
+    trailing_section_div = trailing_section_div
   )
   tab <- set_format_recursive(tab, format, na_str, FALSE)
   table_inset(tab) <- as.integer(inset)
@@ -1615,7 +1618,7 @@ TableTree <- function(kids = list(),
                       prov_footer = character(),
                       page_title = NA_character_,
                       hsep = default_hsep(),
-                      trailing_sep = NA_character_,
+                      trailing_section_div = NA_character_,
                       inset = 0L) {
   check_ok_label(label)
   cinfo <- .calc_cinfo(cinfo, cont, kids)
@@ -1648,7 +1651,7 @@ TableTree <- function(kids = list(),
       main_footer = main_footer,
       prov_footer = prov_footer,
       hsep = hsep,
-      trailing_sep = trailing_sep,
+      trailing_section_div = trailing_section_div,
       inset = inset
     )
   } else {
@@ -1670,7 +1673,7 @@ TableTree <- function(kids = list(),
       provenance_footer = prov_footer,
       page_title_prefix = page_title,
       horizontal_sep = "-",
-      trailing_section_div = trailing_sep
+      trailing_section_div = trailing_section_div
     ) ## this is overridden below to get recursiveness
     tab <- set_format_recursive(tab, format, na_str, FALSE)
 

R/argument_conventions.R

@@ -219,7 +219,7 @@ 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
@@ -231,7 +231,7 @@ 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,
+                        trailing_section_div, split_na_str,
                         cna_str, inset, table_inset) {
   NULL
 }

R/tree_accessors.R

@@ -3118,7 +3118,7 @@ setMethod("page_titles<-", "VTableTree", function(obj, value) {
 })
 
 
-
+## Horizontal separator --------------------------------------------------------
 #' Access or recursively set header-body separator for tables
 #'
 #' @inheritParams gen_args
@@ -3173,29 +3173,38 @@ setMethod(
 )
 
 
-
+## Section dividers ------------------------------------------------------------
+# Used for splits
 setGeneric("spl_section_div", function(obj) standardGeneric("spl_section_div"))
-
 setMethod(
   "spl_section_div", "Split",
   function(obj) obj@child_section_div
 )
 
-
-setGeneric(
-  "spl_section_div<-",
-  function(obj, value) standardGeneric("spl_section_div<-")
-)
-
+setGeneric("spl_section_div<-", function(obj, value) standardGeneric("spl_section_div<-"))
 setMethod(
   "spl_section_div<-", "Split",
   function(obj, value) {
     obj@child_section_div <- value
     obj
   }
 )
+# Used for table parts
+setGeneric("trailing_section_div", function(obj) standardGeneric("trailing_section_div"))
+setMethod("trailing_section_div", "LabelRow", function(obj) obj@trailing_section_div)
+setMethod("trailing_section_div", "TableRow", function(obj) obj@trailing_section_div)
 
+setGeneric("trailing_section_div<-", function(obj, value) standardGeneric("trailing_section_div<-"))
+setMethod("trailing_section_div<-", "LabelRow", function(obj, value) {
+  obj@trailing_section_div <- value
+  obj
+})
+setMethod("trailing_section_div<-", "TableRow", function(obj, value) {
+  obj@trailing_section_div <- value
+  obj
+})
 
+## formatters methods ----------------------------------------------------------
 #' @rdname formatters_methods
 #' @export
 setMethod(
@@ -3292,44 +3301,10 @@ setMethod(
 
 
 
-setGeneric("spl_section_div", function(obj) standardGeneric("spl_section_div"))
-
-setMethod(
-  "spl_section_div", "Split",
-  function(obj) obj@child_section_div
-)
-
-
-setGeneric(
-  "spl_section_div<-",
-  function(obj, value) standardGeneric("spl_section_div<-")
-)
-
-setMethod(
-  "spl_section_div<-", "Split",
-  function(obj, value) {
-    obj@child_section_div <- value
-    obj
-  }
-)
-
-
-
-setGeneric("trailing_sep", function(obj) standardGeneric("trailing_sep"))
-
-setMethod("trailing_sep", "VTableTree", function(obj) obj@trailing_section_div)
-
-setGeneric("trailing_sep<-", function(obj, value) standardGeneric("trailing_sep<-"))
-
-setMethod("trailing_sep<-", "VTableTree", function(obj, value) {
-  obj@trailing_section_div <- value
-  obj
-})
-
 ## setGeneric("apply_kids_section_sep",
 ##            function(tbl, sep) standardGeneric("apply_kids_section_sep"))
 
-## ## eleemntary tables can only have rows and they can't have
+## ## elementary tables can only have rows and they can't have
 ## ## trailing separators
 ## setMethod("apply_kids_section_sep", "ElementaryTable",
 ##           function(tbl, sep) tbl)
@@ -3338,7 +3313,7 @@ setMethod("trailing_sep<-", "VTableTree", function(obj, value) {
 ##    kds <- lapply(tree_children(tbl),
 ##                   function(kid) {
 ##         if(is(kid, "VTableTree"))
-##             trailing_sep(kid) <- sep
+##             trailing_section_div(kid) <- sep
 ##         kid
 ##     })