options for strict tests; few enhancements

insightsengineering · Jan 24, 2024 · 48b2525 · 48b2525
1 parent 39b5fd5
commit 48b2525
Show file tree

Hide file tree

Showing 54 changed files with 86 additions and 129 deletions.
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -39,7 +39,11 @@ repos:
           (.*/|)\.Rprofile|
           (.*/|)\.travis\.y[a]?ml|
           (.*/|)appveyor\.y[a]?ml|
+          (.*/|)CODEOWNERS|
+          (.*/|)DESCRIPTION|
+          (.*/|)LICENSE|
           (.*/|)NAMESPACE|
+          (.*/|)staged_dependencies\.y[a]?ml|
           (.*/|)renv/settings\.dcf|
           (.*/|)renv\.lock|
           (.*/|)WORDLIST|

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -50,19 +50,21 @@ Suggests:
     testthat (>= 3.0.4),
     tibble (>= 3.2.1),
     tidyr (>= 1.1.3),
+    withr (>= 2.0.0),
     xml2 (>= 1.1.0)
 VignetteBuilder:
     knitr
 Config/Needs/verdepcheck: insightsengineering/formatters,
-    tidyverse/magrittr, rstudio/htmltools, tidymodels/broom, cran/car,
-    mllg/checkmate, tidyverse/dplyr, davidgohel/flextable, yihui/knitr,
-    davidgohel/officer, Merck/r2rtf, r-lib/testthat, tidyverse/tibble,
-    tidyverse/tidyr, r-lib/xml2
+    tidyverse/magrittr, mllg/checkmate, rstudio/htmltools,
+    gogolewski/stringi, tidymodels/broom, cran/car, tidyverse/dplyr,
+    davidgohel/flextable, yihui/knitr, davidgohel/officer, Merck/r2rtf,
+    r-lib/testthat, tidyverse/tibble, tidyverse/tidyr, r-lib/withr,
+    r-lib/xml2
 Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
 Collate:
     '00tabletrees.R'
     'Viewer.R'

diff --git a/R/Viewer.R b/R/Viewer.R
@@ -11,8 +11,9 @@ NULL
 #'
 #' @return not meaningful. Called for the side effect of opening a browser or viewer pane.
 #'
-#' @examples
+#' @export
 #'
+#' @examples
 #' if (interactive()) {
 #'   sl5 <- factor(iris$Sepal.Length > 5,
 #'     levels = c(TRUE, FALSE),
@@ -38,7 +39,6 @@ NULL
 #'
 #'   Viewer(tbl, tbl2)
 #' }
-#' @export
 Viewer <- function(x, y = NULL, ...) {
   check_convert <- function(x, name, accept_NULL = FALSE) {
     if (accept_NULL && is.null(x)) {

diff --git a/R/as_html.R b/R/as_html.R
@@ -27,8 +27,8 @@ div_helper <- function(lst, class) {
 #' @param class_table class for `table` tag
 #' @param class_tr class for `tr` tag
 #' @param class_th class for `th` tag
-#' @param width a string to indicate the desired width of the table. Common input formats include a 
-#'   percentage of the viewer window width (e.g. `"100%"`) or a distance value (e.g. `"300px"`). 
+#' @param width a string to indicate the desired width of the table. Common input formats include a
+#'   percentage of the viewer window width (e.g. `"100%"`) or a distance value (e.g. `"300px"`).
 #'   Defaults to `NULL`.
 #' @param link_label link anchor label (not including `tab:` prefix) for the table.
 #' @param bold elements in table output that should be bold. Options are `"main_title"`, `"subtitles"`,
@@ -40,7 +40,6 @@ div_helper <- function(lst, class) {
 #' @return A `shiny.tag` object representing `x` in HTML.
 #'
 #' @examples
-#'
 #' tbl <- rtable(
 #'   header = LETTERS[1:3],
 #'   format = "xx",
@@ -208,7 +207,7 @@ as_html <- function(x,
       list(
         class = class_table,
         style = paste(
-          if (no_spaces_between_cells) "border-collapse: collapse;", 
+          if (no_spaces_between_cells) "border-collapse: collapse;",
           if (!is.null(width)) paste("width:", width)
         ),
         tags$caption(sprintf("(\\#tag:%s)", link_label),

diff --git a/R/colby_constructors.R b/R/colby_constructors.R
@@ -276,7 +276,6 @@ setMethod(
 #' @return A \code{PreDataTableLayouts} object suitable for passing to further
 #'   layouting functions, and to \code{build_table}.
 #' @examples
-#'
 #' lyt <- basic_table() %>%
 #'   split_cols_by("ARM") %>%
 #'   analyze(c("AGE", "BMRKR2"))
@@ -427,7 +426,6 @@ setMethod(
 #' @author Gabriel Becker
 #' @inherit split_cols_by return
 #' @examples
-#'
 #' lyt <- basic_table() %>%
 #'   split_cols_by("ARM") %>%
 #'   split_rows_by("RACE", split_fun = drop_split_levels) %>%
@@ -535,7 +533,6 @@ split_rows_by <- function(lyt,
 #' @seealso [analyze_colvars()]
 #' @inherit split_cols_by return
 #' @examples
-#'
 #' library(dplyr)
 #' ANL <- DM %>% mutate(value = rnorm(n()), pctdiff = runif(n()))
 #'
@@ -1108,7 +1105,6 @@ NULL
 #'
 #'
 #' @examples
-#'
 #' lyt <- basic_table() %>%
 #'   split_cols_by("ARM") %>%
 #'   analyze("AGE", afun = list_wrap_x(summary), format = "xx.xx")
@@ -1234,7 +1230,6 @@ get_acolvar_vars <- function(lyt) {
 #' @author Gabriel Becker
 #'
 #' @examples
-#'
 #' library(dplyr)
 #' ANL <- DM %>% mutate(value = rnorm(n()), pctdiff = runif(n()))
 #'
@@ -1274,7 +1269,7 @@ get_acolvar_vars <- function(lyt) {
 #' tbl2 <- build_table(lyt2, ANL)
 #' tbl2
 #'
-analyze_colvars <- function(lyt, 
+analyze_colvars <- function(lyt,
                             afun,
                             format = NULL,
                             na_str = NA_character_,
@@ -1584,7 +1579,6 @@ setMethod(
 #' @return A `RowsVerticalSection` object with counts (and percents) for each level of the factor
 #' @export
 #' @examples
-#'
 #' counts_wpcts(DM$SEX, 400)
 counts_wpcts <- function(x, .N_col) {
   if (!is.factor(x)) {
@@ -1625,7 +1619,6 @@ counts_wpcts <- function(x, .N_col) {
 #' @author Gabriel Becker
 #'
 #' @examples
-#'
 #' DM2 <- subset(DM, COUNTRY %in% c("USA", "CAN", "CHN"))
 #'
 #' lyt <- basic_table() %>%
@@ -1943,7 +1936,6 @@ manual_cols <- function(..., .lst = list(...)) {
 #'   \code{CellValue} objects.
 #' @author Gabriel Becker
 #' @examples
-#'
 #' summary(iris$Sepal.Length)
 #'
 #' f <- list_wrap_x(summary)
@@ -2009,7 +2001,7 @@ list_wrap_df <- function(f) {
 #'
 #' @inherit split_cols_by return
 #'
-#' @note 
+#' @note
 #' - Because percent components in `colcount_format` are *always*
 #' populated with the value 1, we can get arguably strange results, such as
 #' that individual arm columns and a combined "all patients" column all
@@ -2064,7 +2056,7 @@ basic_table <- function(title = "",
   }
   .check_header_section_div(header_section_div)
   checkmate::assert_character(top_level_section_div, len = 1, n.chars = 1)
-  
+
   ret <- PreDataTableLayouts(
     title = title,
     subtitles = subtitles,

diff --git a/R/compare_rtables.R b/R/compare_rtables.R
@@ -23,7 +23,6 @@
 #' @export
 #'
 #' @examples
-#'
 #' t1 <- rtable(header = c("A", "B"), format = "xx", rrow("row 1", 1, 2))
 #' t2 <- rtable(header = c("A", "B", "C"), format = "xx", rrow("row 1", 1, 2, 3))
 #'

diff --git a/R/indent.R b/R/indent.R
@@ -47,7 +47,7 @@ indent <- function(x, by = 1) {
 #' lyt1 <- basic_table() %>%
 #'   summarize_row_groups("STUDYID", label_fstr = "overall summary") %>%
 #'   split_rows_by("AEBODSYS", child_labels = "visible") %>%
-#'   summarize_row_groups("STUDYID", label = "subgroup summary") %>%
+#'   summarize_row_groups("STUDYID", label_fstr = "subgroup summary") %>%
 #'   analyze("AGE", indent_mod = -1L)
 #'
 #' tbl1 <- build_table(lyt1, ex_adae)

diff --git a/R/make_split_fun.R b/R/make_split_fun.R
@@ -205,7 +205,6 @@ add_to_split_result <- function(splres, values, datasplit, labels, extras = NULL
 #' @seealso [custom_split_funs] for a more detailed discussion on what
 #' custom split functions do.
 #' @examples
-#'
 #' mysplitfun <- make_split_fun(
 #'   pre = list(drop_facet_levels),
 #'   post = list(add_overall_facet("ALL", "All Arms"))

diff --git a/R/split_funs.R b/R/split_funs.R
@@ -258,7 +258,6 @@ NULL
 #'
 #' @export
 #' @examples
-#'
 #' uneven_splfun <- function(df, spl, vals = NULL, labels = NULL, trim = FALSE) {
 #'   ret <- do_base_split(spl, df, vals, labels, trim)
 #'   if (NROW(df) == 0) {
@@ -1010,7 +1009,6 @@ trim_levels_in_group <- function(innervar, drop_outlevs = TRUE) {
 #' @export
 #'
 #' @examples
-#'
 #' lyt <- basic_table() %>%
 #'   split_cols_by("ARM", split_fun = add_overall_level("All Patients",
 #'     first = FALSE

diff --git a/R/summary.R b/R/summary.R
@@ -48,7 +48,6 @@ col_paths <- function(x) {
 #' @export
 #' @return A data.frame summarizing the row- or column-structure of \code{x}.
 #' @examples
-#'
 #' library(dplyr)
 #'
 #' ex_adsl_MF <- ex_adsl %>% filter(SEX %in% c("M", "F"))
@@ -228,7 +227,6 @@ summarize_rows <- function(obj) {
 #' @param indent numeric(1). Indent.
 #'
 #' @examples
-#'
 #' library(dplyr)
 #'
 #' iris2 <- iris %>%

diff --git a/R/tt_afun_utils.R b/R/tt_afun_utils.R
@@ -318,7 +318,6 @@ in_rows <- function(..., .list = NULL, .names = NULL,
 #' @export
 #'
 #' @examples
-#'
 #' s_summary <- function(x) {
 #'   stopifnot(is.numeric(x))
 #'
@@ -390,7 +389,7 @@ in_rows <- function(..., .list = NULL, .names = NULL,
 #'     .N_col = "count in column"
 #'   ),
 #'   .formats = c(nrow_df = "xx.", .N_col = "xx."),
-#'   .indent_mod = c(letters = 1L),
+#'   .indent_mods = c(letters = 1L),
 #'   .ungroup_stats = "letters"
 #' )
 #' a_grp(iris, 40)

diff --git a/R/tt_compatibility.R b/R/tt_compatibility.R
@@ -7,7 +7,6 @@
 #' @return A row object of the context-appropriate type (label or data)
 #' @family compatibility
 #' @examples
-#'
 #' rrow("ABC", c(1, 2), c(3, 2), format = "xx (xx.%)")
 #' rrow("")
 #'
@@ -37,7 +36,7 @@ rrow <- function(row.name = "", ..., format = NULL, indent = 0, inset = 0L) {
     ## if(is.character(formats) && length(unique(formats)) == 1L && is.null(format))
     ##     format = unique(formats)
     DataRow(
-      val = vals, lev = as.integer(indent), label = row.name,
+      vals = vals, lev = as.integer(indent), label = row.name,
       name = row.name, ## XXX TODO
       cspan = csps,
       format = format,
@@ -175,7 +174,6 @@ hrows_to_colinfo <- function(rows) {
 #' @return a \code{InstantiatedColumnInfo} object.
 #' @family compatibility
 #' @examples
-#'
 #' h1 <- rheader(c("A", "B", "C"))
 #'
 #' h2 <- rheader(
@@ -239,7 +237,6 @@ rheader <- function(..., format = "xx", .lst = NULL) {
 #'   or \code{TableTree})
 #' @family compatibility
 #' @examples
-#'
 #' rtable(
 #'   header = LETTERS[1:3],
 #'   rrow("one to three", 1, 2, 3),
@@ -668,7 +665,6 @@ chk_cbindable_many <- function(lst) {
 #' @export
 #'
 #' @examples
-#'
 #' x <- rtable(c("A", "B"), rrow("row 1", 1, 2), rrow("row 2", 3, 4))
 #'
 #' y <- rtable("C", rrow("row 1", 5), rrow("row 2", 6))
@@ -854,7 +850,7 @@ setMethod(
   ## This is ok because LabelRow is special cased
   constr_fun <- get(class(x), mode = "function")
   constr_fun(
-    val = vals,
+    vals = vals,
     cspan = cspans,
     cinfo = cinfo,
     var = obj_avar(x),

diff --git a/R/tt_dotabulation.R b/R/tt_dotabulation.R
@@ -486,7 +486,7 @@ gen_rowvalues <- function(dfpart,
 }
 
 # Makes content table xxx renaming
-.make_ctab <- function(df, 
+.make_ctab <- function(df,
                        lvl, ## treepos,
                        name,
                        label,
@@ -530,7 +530,7 @@ gen_rowvalues <- function(dfpart,
         call. = FALSE
       )
     }
-    
+
   } else {
     contkids <- list()
   }
@@ -580,10 +580,10 @@ gen_rowvalues <- function(dfpart,
     ),
     error = function(e) e
   )
-  
+
   # Adding section_div for DataRows (analyze leaves)
   kids <- .set_kids_section_div(kids, spl_section_div(spl), "DataRow")
-  
+
   if (is(kids, "error")) {
     stop("Error applying analysis function (var - ",
       spl_payload(spl) %||% "colvars", "): ", kids$message,
@@ -940,12 +940,12 @@ setMethod(
       splval = splvals,
       SIMPLIFY = FALSE
     ))
-    
+
     # Setting the kids section separator if they inherits VTableTree
-    inner <- .set_kids_section_div(inner, 
-                                   trailing_section_div_char = spl_section_div(spl), 
+    inner <- .set_kids_section_div(inner,
+                                   trailing_section_div_char = spl_section_div(spl),
                                    allowed_class = "VTableTree")
-    
+
     ## This is where we need to build the structural tables
     ## even if they are invisible because their labels are not
     ## not shown.
@@ -1228,7 +1228,7 @@ recursive_applysplit <- function(df,
 #'
 #' tbl6 <- build_table(lyt3, DM, col_counts = 1:3)
 #' tbl6
-#' 
+#'
 #' @export
 build_table <- function(lyt, df,
                         alt_counts_df = NULL,
@@ -1336,7 +1336,7 @@ build_table <- function(lyt, df,
       first_level_kids
     })
   }
-  
+
   if (nrow(ctab) == 0L && length(kids) == 1L && is(kids[[1]], "VTableTree")) {
     tab <- kids[[1]]
     main_title(tab) <- main_title(lyt)
@@ -1893,7 +1893,6 @@ n_cells_res <- function(res) {
 #' the desired table, suitable for passing to `build_table`.
 #'
 #' @examples
-#'
 #' qtable(ex_adsl)
 #' qtable(ex_adsl, row_vars = "ARM")
 #' qtable(ex_adsl, col_vars = "ARM")