export subset_cols and has_force_pag

NAMESPACE

@@ -103,6 +103,7 @@ export(facet_colcount)
 export(find_degen_struct)
 export(format_rcell)
 export(get_formatted_cells)
+export(has_force_pag)
 export(head)
 export(header_section_div)
 export(horizontal_sep)
@@ -175,6 +176,7 @@ export(split_rows_by_cuts)
 export(split_rows_by_multivar)
 export(split_rows_by_quartiles)
 export(str)
+export(subset_cols)
 export(summarize_row_groups)
 export(table_shell)
 export(table_shell_str)
@@ -258,6 +260,7 @@ exportMethods(coltree)
 exportMethods(content_table)
 exportMethods(dim)
 exportMethods(facet_colcount)
+exportMethods(has_force_pag)
 exportMethods(head)
 exportMethods(horizontal_sep)
 exportMethods(length)
@@ -290,6 +293,7 @@ exportMethods(row_values)
 exportMethods(simple_analysis)
 exportMethods(spl_variable)
 exportMethods(str)
+exportMethods(subset_cols)
 exportMethods(subtitles)
 exportMethods(table_inset)
 exportMethods(tail)

NEWS.md

@@ -20,6 +20,10 @@
  * `section_div<-` no longer sets a section div on non-visible label rows when setting a section divider for a content row on the same group. #1024 by @gmbecker
  * `section_div<-` when given a full-length (`nrow(tt)`) vector now sets 'section dividers' on label rows and content rows correctly when both are visible for the same facet. #1024 by @gmbecker
 
+### Miscellaneous
+ * `subset_cols` generic and methods are now exported.
+ * `has_force_pag` generic and methods are now exported.
+
 ## rtables 0.6.12
 
 ### New Features

R/tree_accessors.R

@@ -3835,12 +3835,20 @@ setMethod(
   }
 )
 
+#' @export
+#' @rdname int_methods
 setGeneric("has_force_pag", function(obj) standardGeneric("has_force_pag"))
 
+#' @exportMethod has_force_pag
+#' @rdname int_methods
 setMethod("has_force_pag", "TableTree", function(obj) !is.na(ptitle_prefix(obj)))
 
+#' @exportMethod has_force_pag
+#' @rdname int_methods
 setMethod("has_force_pag", "Split", function(obj) !is.na(ptitle_prefix(obj)))
 
+#' @exportMethod has_force_pag
+#' @rdname int_methods
 setMethod("has_force_pag", "VTableNodeInfo", function(obj) FALSE)
 
 setGeneric("ptitle_prefix", function(obj) standardGeneric("ptitle_prefix"))

R/tt_pos_and_access.R

@@ -843,7 +843,33 @@ setMethod(
 
 ## we have two options here: path like we do with rows and positional
 ## in leaf space.
-
+#' Subset a table or row to particular columns
+#' @inheritParams gen_args
+#' @inheritParams brackets
+#' @inheritParams head
+#' @param j (`integer`, `logical` or `character`)\cr The column(s) to subset `tt`
+#'   down to. Character vectors are interpreted as a *column path*, not as names.
+#'   Path can include `"*"` wildcards.
+#' @param newcinfo (`NULL` or `InstantiatedColumnInfo`)\cr The new column info,
+#'   if precomputed. Generally should not be manually set by users.
+#' @param ... Ignored.
+#'
+#' @examples
+#' lyt <- basic_table(
+#'   title = "Title",
+#'   subtitles = c("Sub", "titles"),
+#'   prov_footer = "prov footer",
+#'   main_footer = "main footer"
+#' ) %>%
+#'   split_cols_by("ARM") %>%
+#'   split_cols_by("SEX") %>%
+#'   analyze(c("AGE"))
+#'
+#' tbl <- build_table(lyt, DM)
+#'
+#' subset_cols(tbl, c(1, 3))
+#' subset_cols(tbl, c("ARM", "*", "SEX", "F"))
+#' @export
 setGeneric(
   "subset_cols",
   function(tt,
@@ -857,6 +883,8 @@ setGeneric(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("TableTree", "numeric"),
   function(tt, j, newcinfo = NULL,
@@ -889,6 +917,8 @@ setMethod(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("ElementaryTable", "numeric"),
   function(tt, j, newcinfo = NULL,
@@ -1021,6 +1051,8 @@ select_cells_j <- function(cells, j) {
   }, cl = retcells, sp = newspans, SIMPLIFY = FALSE)
 }
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("ANY", "character"),
   function(tt, j, newcinfo = NULL, keep_topleft = TRUE, ...) {
@@ -1029,6 +1061,8 @@ setMethod(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("TableRow", "numeric"),
   function(tt, j, newcinfo = NULL, keep_topleft = TRUE, ...) {
@@ -1048,6 +1082,8 @@ setMethod(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("LabelRow", "numeric"),
   function(tt, j, newcinfo = NULL, keep_topleft = TRUE, ...) {
@@ -1061,6 +1097,8 @@ setMethod(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("InstantiatedColumnInfo", "numeric"),
   function(tt, j, newcinfo = NULL, keep_topleft = TRUE, ...) {
@@ -1085,6 +1123,8 @@ setMethod(
   }
 )
 
+#' @exportMethod subset_cols
+#' @rdname subset_cols
 setMethod(
   "subset_cols", c("LayoutColTree", "numeric"),
   function(tt, j, newcinfo = NULL, ...) {

_pkgdown.yml

@@ -199,6 +199,7 @@ reference:
     - cbind_rtables
     - asvec
     - brackets
+    - subset_cols
     - clear_indent_mods
     - head
     - section_div

tests/testthat/test-pagination.R

@@ -7,8 +7,15 @@ test_that("Page by splitting works", {
     analyze("AGE")
 
   tt <- build_table(lyt, DM)
+  expect_true(has_force_pag(tt))
+
+  expect_false(any(vapply(collect_leaves(tt, add.labrows = TRUE), has_force_pag, NA)))
+
+  expect_false(has_force_pag(VarLevelSplit("AGE", "Age")))
+  expect_true(has_force_pag(VarLevelSplit("AGE", "Age", page_prefix = "hi")))
 
   ttlst <- paginate_table(tt)
+  expect_false(any(vapply(ttlst, has_force_pag, NA)))
 
   expect_identical(
     names(ttlst),