1095 intermediate nesting

DESCRIPTION

@@ -77,6 +77,7 @@ Collate:
     'argument_conventions.R'
     'as_html.R'
     'utils.R'
+    'nesting_impl.R'
     'colby_constructors.R'
     'compare_rtables.R'
     'format_rcell.R'

NAMESPACE

@@ -105,6 +105,7 @@ export(export_as_txt)
 export(facet_colcount)
 export(find_degen_struct)
 export(format_rcell)
+export(get_anchor_list)
 export(get_formatted_cells)
 export(has_force_pag)
 export(head)
@@ -269,6 +270,7 @@ exportMethods(coltree)
 exportMethods(content_table)
 exportMethods(dim)
 exportMethods(facet_colcount)
+exportMethods(get_anchor_list)
 exportMethods(has_force_pag)
 exportMethods(head)
 exportMethods(horizontal_sep)

NEWS.md

@@ -20,9 +20,13 @@
  * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Accessing Table Values @gmbecker
  * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Custom Scoring Functions For Sorting @gmbecker
  * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects - (stub) Custom Pruning Functions @gmbecker
-
+ * Added `at_sibling` parameter to `split_rows_by*` and `analyze` functions, enabling placement of a new layout directive as a direct sibling of a previously declared split or analysis @gmbecker
+ * Added `get_anchor_list()` function for inspecting the available sibling anchors in an existing layout @gmbecker
+ * `label_pos` now accepts `"default"` as a value, which resolves to `"visible"` when `at_sibling` is non-`NULL` and `"hidden"` otherwise @gmbecker
+
 ### Bug Fixes
  * `indent_mod<-` `RowsVerticalSection` method now correctly recycles length 1 values @gmbecker
+ * Fixed `uniqify_child_names` emitting messages ending in a literal `FALSE` due to passing `call. = FALSE` to `message()`, which does not accept that argument @gmbecker
 
 ## rtables 0.6.15
 

R/00tabletrees.R

@@ -27,9 +27,9 @@ check_ok_label <- function(lbl, multi_ok = FALSE) {
 }
 
 valid_lbl_pos <- c("default", "visible", "hidden", "topleft")
-.labelkids_helper <- function(charval) {
+.labelkids_helper <- function(charval, na_ok = TRUE) {
   ret <- switch(charval,
-    "default" = NA,
+    "default" = if (na_ok) NA else FALSE,
     "visible" = TRUE,
     "hidden" = FALSE,
     "topleft" = FALSE,
@@ -466,7 +466,7 @@ MultiVarSplit <- function(vars,
                           colcount_format = NULL) {
   check_ok_label(split_label)
   ## no topleft allowed
-  label_pos <- match.arg(label_pos, label_pos_values[-3])
+  label_pos <- match.arg(label_pos, label_pos_values[-4])
   child_labels <- match.arg(child_labels)
   if (length(vars) == 1 && grepl(":", vars)) {
     vars <- strsplit(vars, ":")[[1]]
@@ -1656,8 +1656,7 @@ uniqify_child_names <- function(kidlst) {
       paste(val_to_fix, " -> {", paste(c(val_to_fix, newnms), collapse = ", "), "}]\n"),
       "  To control table names use split_rows_by*(, parent_name =.) or ",
       " analyze(., table_names = .) when analyzing a single variable, or ",
-      "analyze(., parent_name = .) when analyzing multiple variables in a single call.",
-      call. = FALSE
+      "analyze(., parent_name = .) when analyzing multiple variables in a single call."
     )
     names(kidlst)[inds] <- newnms
   }
@@ -1914,6 +1913,10 @@ TableTree <- function(kids = list(),
 ## a pre-existing TableTree/ElementaryTable.
 ## This is used for add_existing_table in colby_constructors.R
 
+split_or_splitvectree <- function(object) {
+  is(object, "Split") || is(object, "SplitVectorTree")
+}
+
 setClass("SplitVector",
   contains = "list",
   validity = function(object) {
@@ -1922,8 +1925,8 @@ setClass("SplitVector",
     } else {
       lst <- NULL
     }
-    all(sapply(head(object, -1), is, "Split")) &&
-      (is.null(lst) || is(lst, "Split") || is(lst, "VTableNodeInfo"))
+    all(sapply(head(object, -1), split_or_splitvectree)) &&
+      (is.null(lst) || split_or_splitvectree(lst) || is(lst, "VTableNodeInfo"))
   }
 )
 
@@ -1936,7 +1939,28 @@ SplitVector <- function(x = NULL,
   new("SplitVector", lst)
 }
 
+setClass("SplitVectorTree",
+  contains = "list",
+  validity = function(object) {
+    all(vapply(object, function(x) is(x, "SplitVector") || is(x, "SplitVectorTree"), TRUE))
+  }
+)
+
+SplitVectorTree <- function(x = NULL,
+                            ...,
+                            lst = list(...)) {
+  if (is.null(x)) {
+    xlst <- NULL
+  } else {
+    xlst <- list(x)
+  }
+  new("SplitVectorTree", c(xlst, lst))
+}
+
 avar_noneorlast <- function(vec) {
+  if (is(vec, "SplitVectorTree")) {
+    return(all(sapply(vec, avar_noneorlast)))
+  }
   if (!is(vec, "SplitVector")) {
     return(FALSE)
   }

R/argument_conventions.R

@@ -150,6 +150,10 @@ gen_args <- function(df, alt_counts_df, spl, pos, tt, tr, verbose, colwidths, ob
 #'   to the *split* or *group of sibling analyses*, for `split_rows_by*` and
 #' `analyze*` when analyzing more than one variable, respectively. Ignored when
 #' analyzing a single variable.
+#' @param at_sibling (`character(1)` or `NULL`)\cr If non-null, a preceding
+#'   split or analyze to anchor this instruction to as a direct sibling. Cannot
+#'   select an instruction that is downstream of a point where a previously used
+#'   anchor (See Nesting Anchor Resolution for details).
 #'
 #' @inherit gen_args return
 #'
@@ -165,7 +169,8 @@ lyt_args <- function(lyt, var, vars, label, labels_var, varlabels, varnames, spl
                      var_labels, cvar,
                      table_names, topleft, align, page_by, page_prefix,
                      format_na_str, section_div, na_str, show_colcounts,
-                     colcount_format, parent_name, formats_var, na_strs_var) {
+                     colcount_format, parent_name, formats_var, na_strs_var,
+                     at_sibling) {
   NULL
 }