1092 add guided advanced

.pre-commit-config.yaml

@@ -6,18 +6,19 @@ default_language_version:
   python: python3
 repos:
   - repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.3.9021
+    rev: v0.4.3.9025
     hooks:
       - id: roxygenize
         additional_dependencies:
-          - insightsengineering/formatters
+          - formatters
           - magrittr
           - methods
           - checkmate
           - htmltools
           - lifecycle
           - stats
           - stringi
+          - roxygen2
       - id: use-tidy-description
       - id: spell-check
         exclude: >

DESCRIPTION

@@ -67,7 +67,6 @@ Config/Needs/verdepcheck: insightsengineering/formatters,
     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
@@ -105,3 +104,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,8 +1,26 @@
 ## rtables 0.6.16.9001
 
 ### New Features
- * Added `restrict_facets` function factory for use with `make_split_fun`
- * Exportd previously internal `make_subset_expr` for use when constructing custom splitting behavior
+ * 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
+ * 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
+ * `obj_na_str<-` RowsVerticalSection method now correctly recycles length 1 values @gmbecker
 
 ## rtables 0.6.15
 

R/00tabletrees.R

@@ -2182,6 +2182,43 @@ 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

@@ -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

@@ -68,6 +68,19 @@ articles:
     - 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
@@ -323,3 +336,4 @@ reference:
     - length,CellValue-method
     - names,VTableNodeInfo-method
     - insert_rrow
+    - c.RowsVerticalSection

inst/WORDLIST

@@ -7,6 +7,7 @@ amongst
 ARD
 ard
 ARDs
+BBBs
 biomarker
 BMEASIFL
 Bov
@@ -80,6 +81,7 @@ responder
 Resync
 reusability
 roadmap
+RowsVerticalSection
 RStudio
 rtables
 Rua