1092 add guided advanced

.pre-commit-config.yaml

@@ -17,6 +17,7 @@ repos:
           - lifecycle
           - stats
           - stringi
+          - roxygen2
       - id: use-tidy-description
       - id: spell-check
         exclude: >

DESCRIPTION

@@ -66,7 +66,6 @@ Config/Needs/verdepcheck: pharmaverse/formatters, mllg/checkmate,
     davidgohel/officer, Merck/r2rtf, rstudio/rmarkdown, therneau/survival,
     r-lib/testthat, tidyverse/tibble, tidyverse/tidyr, r-lib/withr,
     r-lib/xml2
-Config/roxygen2/version: 8.0.0
 Encoding: UTF-8
 Language: en-US
 LazyData: true
@@ -104,3 +103,4 @@ Collate:
     'tt_from_df.R'
     'validate_table_struct.R'
     'zzz_constants.R'
+Config/roxygen2/version: 8.0.0

NAMESPACE

@@ -1,5 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(c,RowsVerticalSection)
 S3method(print,CellValue)
 S3method(print,RowsVerticalSection)
 export("cell_footnotes<-")

NEWS.md

@@ -1,10 +1,28 @@
 ## rtables 0.6.16.9003
 
 ### New Features
- * Added `restrict_facets` function factory for use with `make_split_fun`
+ * Added `restrict_facets` function factory for use with `make_split_fun` @gmbecker
  * Exported previously internal `make_subset_expr` for use when constructing custom splitting behavior
  * Exported previously internal `splv_extra` and `splv_extra<-` accessors for getting and setting child-specific extra arguments on `SplitValue` objects.
  * Exported previously internal `value_expr` accessor for retrieving the subsetting expression from a `SplitValue` or `ValueWrapper` object.
+ * Added accessor methods for `RowsVerticalSection objects`: `row_cells`, `obj_format`, `obj_format<-`, `obj_na_str`, `obj_na_str<-`, `cell_values`
+ * Added `c` method for directly combining `RowsVerticalSection` objects
+ * Added vignette: Guided Tour (Advanced) @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Custom Analysis And Summary Functions @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Analysis Functions - Split Context @gmbecker 
+ * Added vignette: Guided Tour (Advanced) - Analysis Functions - Combining Existing `afun`s @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Analysis Functions - (stub) Useful Building Blocks @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Custom Split Functions @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Custom Split Functions - (stub) `make_split_fun` @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Custom Split Functions - Behavioral Building Block @gmbecker
+ * Added vignette: Guided Tour (Advanced) - Custom Split Functions - (stub) Worked Examples @gmbecker
+ * Added vignette: Guided Tour (Advanced) - (stub) `TableTree` Objects @gmbecker
+ * 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
+
+### Bug Fixes
+ * `indent_mod<-` `RowsVerticalSection` method now correctly recycles length 1 values @gmbecker
 
 ## rtables 0.6.15
 

R/00tabletrees.R

@@ -2206,6 +2206,44 @@ print.RowsVerticalSection <- function(x, ...) {
   invisible(x)
 }
 
+#' Combine `RowsVerticalSection` objects
+#'
+#' Combine two or more `RowsVerticalSection` objects (as returned
+#' by [in_rows()]) into a single object
+#'
+#' @param ... `RowsVerticalSection` objects
+#' @returns A single `RowsVerticalSection` object containing all
+#'   row sections from the objects passed to `...`
+#' @export
+c.RowsVerticalSection <- function(...) {
+  lst <- list(...)
+  if (!all(vapply(lst, function(x) inherits(x, "RowsVerticalSection"), TRUE))) {
+    stop("Cannot use c() to combine RowsVerticalSection objects with objects of other classes")
+  }
+
+  out <- NextMethod(generic = "c")
+  out <- RowsVerticalSection(
+    out,
+    names = comb_attr_w_dflt(lst, "row_names"),
+    labels = comb_attr_w_dflt(lst, "row_labels"),
+    indent_mods = comb_attr_w_dflt(lst, "indent_mods", 0L),
+    formats = comb_attr_w_dflt(lst, "row_formats", "xx"),
+    footnotes = comb_attr_w_dflt(lst, "row_footnotes"),
+    format_na_strs = comb_attr_w_dflt(lst, "row_na_strs", NA_character_)
+  )
+  out
+}
+
+comb_attr_w_dflt <- function(lst, attrname, dflt = NULL) {
+  unlist(
+    lapply(lst, function(x) {
+      attr(x, attrname, exact = TRUE) %||% rep(dflt, length(x))
+    }),
+    recursive = FALSE,
+    use.names = FALSE
+  )
+}
+
 #### Empty default objects to avoid repeated calls
 ## EmptyColInfo <- InstantiatedColumnInfo()
 ## EmptyElTable <- ElementaryTable()

R/make_split_fun.R

@@ -394,7 +394,7 @@ add_overall_facet <- function(name, label, extra = list()) {
 #'
 #' @param innervar (`character`)\cr the variable(s) to trim (remove unobserved levels) independently within each facet.
 #'
-#' @return A function suitable for use in the `pre` (list) argument of `make_split_fun`.
+#' @return A function suitable for use in the `post` (list) argument of `make_split_fun`.
 #'
 #' @seealso [make_split_fun()]
 #'

R/tree_accessors.R

@@ -999,6 +999,10 @@ setGeneric("row_cells", function(obj) standardGeneric("row_cells"))
 #' @exportMethod row_cells
 setMethod("row_cells", "TableRow", function(obj) obj@leaf_value)
 
+#' @rdname row_accessors
+#' @exportMethod row_cells
+setMethod("row_cells", "RowsVerticalSection", function(obj) as(obj, "list", strict = TRUE))
+
 #' @rdname row_accessors
 setGeneric("row_cells<-", function(obj, value) standardGeneric("row_cells<-"))
 
@@ -1017,7 +1021,6 @@ setGeneric("row_values", function(obj) standardGeneric("row_values"))
 #' @exportMethod row_values
 setMethod("row_values", "TableRow", function(obj) rawvalues(obj@leaf_value))
 
-
 #' @rdname row_accessors
 #' @exportMethod row_values<-
 setGeneric("row_values<-", function(obj, value) standardGeneric("row_values<-"))
@@ -1153,13 +1156,18 @@ setMethod("obj_format", "CellValue", function(obj) attr(obj, "format", exact = T
 #' @export
 setMethod("obj_format", "Split", function(obj) obj@split_format)
 
+#' @rdname formatters_methods
+#' @export
+setMethod("obj_format", "RowsVerticalSection", function(obj) attr(obj, "row_formats", exact = TRUE))
+
 #' @rdname formatters_methods
 #' @export
 setMethod("obj_format<-", "VTableNodeInfo", function(obj, value) {
   obj@format <- value
   obj
 })
 
+
 #' @rdname formatters_methods
 #' @export
 setMethod("obj_format<-", "Split", function(obj, value) {
@@ -1174,13 +1182,27 @@ setMethod("obj_format<-", "CellValue", function(obj, value) {
   obj
 })
 
+#' @rdname formatters_methods
+#' @export
+setMethod("obj_format<-", "RowsVerticalSection", function(obj, value) {
+  attr(obj, "row_formats") <- value
+  obj
+})
+
 #' @rdname int_methods
 #' @export
 setMethod("obj_na_str<-", "CellValue", function(obj, value) {
   attr(obj, "format_na_str") <- value
   obj
 })
 
+#' @rdname int_methods
+#' @export
+setMethod("obj_na_str<-", "RowsVerticalSection", function(obj, value) {
+  attr(obj, "row_na_strs") <- value
+  obj
+})
+
 #' @rdname int_methods
 #' @export
 setMethod("obj_na_str<-", "VTableNodeInfo", function(obj, value) {
@@ -1199,6 +1221,10 @@ setMethod("obj_na_str<-", "Split", function(obj, value) {
 #' @export
 setMethod("obj_na_str", "VTableNodeInfo", function(obj) obj@na_str)
 
+#' @rdname int_methods
+#' @export
+setMethod("obj_na_str", "RowsVerticalSection", function(obj) attr(obj, "row_na_strs", exact = TRUE))
+
 #' @rdname formatters_methods
 #' @export
 setMethod("obj_na_str", "Split", function(obj) obj@split_na_str)
@@ -1678,7 +1704,7 @@ setMethod(
         "must have length 1 or the number of rows"
       )
     }
-    attr(obj, "indent_mods") <- as.integer(value)
+    attr(obj, "indent_mods") <- rep(as.integer(value), length.out = length(obj))
     obj
 
     ## obj@indent_mods <- value

R/tt_pos_and_access.R

@@ -755,7 +755,7 @@ setMethod(
       }
 
       if (labelrow_visible(x)) {
-        counter <<- counter + 1
+        counter <<- counter + 1 # nolint: assignment_linter.
         if (counter %in% i) {
           nxtval <- value[[1]]
           if (is(nxtval, "LabelRow")) {
@@ -768,7 +768,7 @@ setMethod(
           }
           ## we're done with this one move to
           ## the next
-          value <<- value[-1]
+          value <<- value[-1] # nolint: assignment_linter.
         }
       }
       if (is(x, "TableTree") && nrow(content_table(x)) > 0) {
@@ -785,7 +785,7 @@ setMethod(
         for (pos in seq_along(kids)) {
           curkid <- kids[[pos]]
           if (is(curkid, "TableRow")) {
-            counter <<- counter + 1
+            counter <<- counter + 1 # nolint: assignment_linter.
             if (counter %in% i) {
               nxtval <- value[[1]]
               if (is(nxtval, class(curkid))) {
@@ -1143,7 +1143,7 @@ setMethod(
       newkids <- kids
       for (i in seq_along(newkids)) {
         if (is(newkids[[i]], "LayoutColLeaf")) {
-          counter <<- counter + 1
+          counter <<- counter + 1 # nolint: assignment_linter.
           if (!(counter %in% j)) {
             newkids[[i]] <- list()
           } ## NULL removes the position entirely
@@ -1198,7 +1198,7 @@ subset_by_rownum <- function(tt,
     }
 
     if (labelrow_visible(x)) {
-      counter <<- counter + 1
+      counter <<- counter + 1 # nolint: assignment_linter.
       if (!(counter %in% i)) {
         ## XXX this should do whatever
         ## is required to 'remove' the Label Row
@@ -1224,7 +1224,7 @@ subset_by_rownum <- function(tt,
     } else if (length(kids) > 0) {
       for (pos in seq_along(kids)) {
         if (is(kids[[pos]], "TableRow")) {
-          counter <<- counter + 1
+          counter <<- counter + 1 # nolint: assignment_linter.
           if (!(counter %in% i)) {
             kids[[pos]] <- list()
           }
@@ -1584,6 +1584,14 @@ setMethod(
   }
 )
 
+#' @rdname int_methods
+#' @keywords internal
+#' @exportMethod cell_values
+setMethod(
+  "cell_values", "RowsVerticalSection",
+  function(tt, rowpath, colpath = NULL, omit_labrows = TRUE) rawvalues(tt)
+)
+
 #' @rdname int_methods
 #' @keywords internal
 #' @exportMethod cell_values

_pkgdown.yml

@@ -64,10 +64,25 @@ articles:
   - title: Guided Tour
     navbar: Guided Tour
     contents:
+    - guided_intro_basics
+    - guided_intro_nesting
     - guided_intermediate
     - guided_intermediate_translating_shells
     - guided_intermediate_afun_reqs
     - guided_intermediate_split_reqs
+    - guided_advanced
+    - guided_advanced_afuns
+    - guided_advanced_afuns_spl_context
+    - guided_advanced_afuns_rowsverticalsection
+    - guided_advanced_afuns_building_blocks
+    - guided_advanced_split_funs
+    - guided_advanced_split_funs_make_split_fun
+    - guided_advanced_split_funs_new_bbbs
+    - guided_advanced_split_funs_worked_ex
+    - guided_advanced_tt
+    - guided_advanced_tt_access
+    - guided_advanced_tt_score_funs
+    - guided_advanced_tt_prune_funs
 
   - title: Clinical Trials
     navbar: Clinical Trials
@@ -326,3 +341,4 @@ reference:
     - length,CellValue-method
     - names,VTableNodeInfo-method
     - insert_rrow
+    - c.RowsVerticalSection

inst/WORDLIST

@@ -1,6 +1,49 @@
 Abinaya
 AE
 AEs
+ARD
+ARDs
+BBBs
+biomarker
+BMEASIFL
+Bové
+CRAN's
+Carreras
+Cheatsheet
+Chohan
+FFFL
+Godwin
+Heng
+Hoffmann
+Kelkhoff
+Layouting
+Lewandowski
+Maximo
+Modelling
+NSE
+ORCID
+Paszty
+Pathing
+Pharma
+Phuse
+Postprocessing
+Pre
+Qi
+RStudio
+Resync
+Rua
+SKELETOMUSCULAR
+STUDYID
+Sabanés
+Saibah
+Stoilova
+Subtable
+Subtables
+Tadeusz
+Tord
+Unstratified
+ValueWrapper
+Yung
 afun
 afuns
 amongst