608 checkmate no stopifnot@main (insightsengineering#622)

R/abnormal_by_baseline.R

@@ -184,7 +184,7 @@ count_abnormal_by_baseline <- function(lyt,
                                        .formats = NULL,
                                        .labels = NULL,
                                        .indent_mods = NULL) {
-  checkmate::assert(!is.null(names(abnormal)))
+  checkmate::assert_false(is.null(names(abnormal)))
   checkmate::assert_string(var)
   assert_equal_length(abnormal, table_names)
   afun <- make_afun(

R/coxph.R

@@ -349,7 +349,7 @@ s_cox_univariate <- function(formula,
 
 # Get the right-hand-term of a formula
 rht <- function(x) {
-  stopifnot(inherits(x, "formula"))
+  checkmate::assert_formula(x)
   y <- as.character(rev(x)[[1]])
   return(y)
 }

R/decorate_grob.R

@@ -241,15 +241,25 @@ decorate_grob <- function(grob,
 #' @importFrom grid validDetails
 #' @export
 validDetails.decoratedGrob <- function(x) { # nolint
-  stopifnot(
-    grid::is.grob(x$grob) || is.null(x$grob),
-    is.character(x$titles),
-    is.character(x$footnotes),
-    is.character(x$page) || length(x$page) != 1,
-    grid::is.unit(x$outer_margins) || length(x$outer_margins) == 4,
-    grid::is.unit(x$margins) || length(x$margins) == 4,
-    grid::is.unit(x$padding) || length(x$padding) == 4
-  )
+
+  checkmate::assert_character(x$titles)
+  checkmate::assert_character(x$footnotes)
+
+  if (!is.null(x$grob)) {
+    checkmate::assert_true(grid::is.grob(x$grob))
+  }
+  if (length(x$page) == 1) {
+    checkmate::assert_character(x$page)
+  }
+  if (!grid::is.unit(x$outer_margins)) {
+    checkmate::assert_vector(x$outer_margins, len = 4)
+  }
+  if (!grid::is.unit(x$margins)) {
+    checkmate::assert_vector(x$margins, len = 4)
+  }
+  if (!grid::is.unit(x$padding)) {
+    checkmate::assert_vector(x$padding, len = 4)
+  }
 
   x
 }
@@ -360,7 +370,8 @@ split_text_grob <- function(text,
     y <- grid::unit(y, default.units)
   }
 
-  stopifnot(grid::is.unit(width) && length(width) == 1)
+  checkmate::assert_true(grid::is.unit(width))
+  checkmate::assert_vector(width, len = 1)
 
   ## if it is a fixed unit then we do not need to recalculate when viewport resized
   if (!inherits(width, "unit.arithmetic") &&
@@ -388,11 +399,9 @@ split_text_grob <- function(text,
 #' @importFrom grid validDetails
 #' @export
 validDetails.dynamicSplitText <- function(x) { # nolint
-  stopifnot(
-    is.character(x$text),
-    grid::is.unit(x$width) && length(x$width) == 1
-  )
-
+  checkmate::assert_character(x$text)
+  checkmate::assert_true(grid::is.unit(x$width))
+  checkmate::assert_vector(x$width, len = 1)
   x
 }
 

R/g_forest.R

@@ -154,19 +154,22 @@ g_forest <- function(tbl, # nolint
                      col_symbol_size = attr(tbl, "col_symbol_size"),
                      draw = TRUE,
                      newpage = TRUE) {
-  stopifnot(inherits(tbl, "VTableTree"))
+  checkmate::assert_class(tbl, "VTableTree")
 
   nr <- nrow(tbl)
   nc <- ncol(tbl)
 
   checkmate::assert_false(is.null(col_x))
   checkmate::assert_false(is.null(col_ci))
 
-  stopifnot(
-    col_x > 0 && col_x <= nc,
-    col_ci > 0 && col_ci <= nc,
-    is.null(col_symbol_size) || col_symbol_size > 0 && col_symbol_size <= nc
-  )
+  checkmate::assert_number(col_x, lower = 0, upper = nc)
+  checkmate::assert_number(col_ci, lower = 0, upper = nc)
+  checkmate::assert_number(col_symbol_size, lower = 0, upper = nc, null.ok = TRUE)
+  checkmate::assert_true(col_x > 0)
+  checkmate::assert_true(col_ci > 0)
+  if (!is.null(col_symbol_size)) {
+    checkmate::assert_true(col_symbol_size > 0)
+  }
 
   x_e <- vapply(seq_len(nr), function(i) {
     xi <- as.vector(tbl[i, col_x, drop = TRUE])
@@ -302,19 +305,18 @@ forest_grob <- function(tbl,
                         name = NULL,
                         gp = NULL,
                         vp = NULL) {
-  stopifnot(
-    !is.null(vline) || is.null(forest_header),
-    is.null(forest_header) || length(forest_header) == 2,
-    is.null(vline) || length(vline) == 1
-  )
-
   nr <- nrow(tbl)
-  stopifnot(
-    is.numeric(x) && length(x) == nr,
-    is.numeric(lower) && length(lower) == nr,
-    is.numeric(upper) && length(upper) == nr,
-    is.null(symbol_size) || length(symbol_size) == nr
-  )
+  if (is.null(vline)) {
+    checkmate::assert_true(is.null(forest_header))
+  } else {
+    checkmate::assert_number(vline)
+    checkmate::assert_character(forest_header, len = 2, null.ok = TRUE)
+  }
+
+  checkmate::assert_numeric(x, len = nr)
+  checkmate::assert_numeric(lower, len = nr)
+  checkmate::assert_numeric(upper, len = nr)
+  checkmate::assert_numeric(symbol_size, len = nr, null.ok = TRUE)
 
   if (is.null(symbol_size)) {
     symbol_size <- rep(1, nr)
@@ -489,9 +491,7 @@ cell_in_rows <- function(row_name,
                          cell_spans,
                          row_index,
                          underline_colspan = FALSE) {
-  stopifnot(
-    length(cells) == length(cell_spans)
-  )
+  assert_equal_length(cells, cell_spans)
   checkmate::assert_string(row_name)
   checkmate::assert_character(cells, min.len = 1, any.missing = FALSE)
   checkmate::assert_numeric(cell_spans, min.len = 1, any.missing = FALSE)
@@ -677,12 +677,14 @@ forest_viewport <- function(tbl,
                             gap_column = grid::unit(1, "lines"),
                             gap_header = grid::unit(1, "lines"),
                             mat_form = NULL) {
-  stopifnot(
-    inherits(tbl, "VTableTree"),
-    is.null(width_row_names) || grid::is.unit(width_row_names),
-    is.null(width_columns) || grid::is.unit(width_columns),
-    grid::is.unit(width_forest)
-  )
+  checkmate::assert_class(tbl, "VTableTree")
+  checkmate::assert_true(grid::is.unit(width_forest))
+  if (!is.null(width_row_names)) {
+    checkmate::assert_true(grid::is.unit(width_row_names))
+  }
+  if (!is.null(width_columns)) {
+    checkmate::assert_true(grid::is.unit(width_columns))
+  }
 
   if (is.null(mat_form)) mat_form <- matrix_form(tbl)
 
@@ -874,7 +876,3 @@ footnotes <- function(x) {
   footnotes(x) <- c(footnotes(x), value)
   x
 }
-`add_footnotes<-` <- function(x, value) { # nolint
-  footnotes(x) <- c(footnotes(x), value)
-  x
-}

R/h_response_subgroups.R

@@ -167,8 +167,7 @@ h_proportion_subgroups_df <- function(variables,
 #' )
 h_odds_ratio_df <- function(rsp, arm, strata_data = NULL, conf_level = 0.95, method = NULL) {
   assert_equal_length(rsp, arm)
-  checkmate::assert_set_equal(nlevels(arm), 2)
-  assert_valid_factor(arm)
+  assert_valid_factor(arm, n.levels = 2)
 
   df_rsp <- data.frame(
     rsp = rsp,

R/h_survival_duration_subgroups.R

@@ -420,7 +420,7 @@ h_split_by_subgroups <- function(data,
                                  groups_lists = list()) {
   checkmate::assert_character(subgroups, min.len = 1, any.missing = FALSE)
   checkmate::assert_list(groups_lists, names = "named")
-  checkmate::assert(all(names(groups_lists) %in% subgroups))
+  checkmate::assert_subset(names(groups_lists), subgroups)
   assert_df_with_factors(data, as.list(stats::setNames(subgroups, subgroups)))
 
   data_labels <- unname(formatters::var_labels(data))

R/prop_diff.R

@@ -24,7 +24,7 @@ check_diff_prop_ci <- function(rsp,
                                strata = NULL,
                                conf_level,
                                correct = NULL) {
-  checkmate::assert(!anyNA(c(rsp, grp)))
+  checkmate::assert_false(anyNA(c(rsp, grp)))
   checkmate::assert_logical(rsp)
   checkmate::assert_set_equal(nlevels(grp), 2)
   checkmate::assert_number(conf_level, lower = 0, upper = 1)

R/utils_checkmate.R

@@ -1,12 +1,17 @@
 #' Additional Assertions for `checkmate`
 #'
 #' @description
-#' We provide additional assertion functions which can be used together with [checkmate::assert()].
+#' Additional assertion functions which can be used together with the `checkmate` package.
 #'
-#' @param x object to test
-#' @param df supposed data frame to test
-#' @param variables (named `list` of `character`)\cr supposed variables list to test
+#' @param x (`any`)\cr object to test.
+#' @param df (`data frame`)\cr data set to test.
+#' @param variables (named `list` of `character`)\cr list of variables to test.
 #' @param include_boundaries (`logical`)\cr whether to include boundaries when testing for proportions.
+#' @param na_level (`character`)\cr the string you have been using to represent NA or
+#'   missing data. For `NA` values please consider using directly `base::is.na` or
+#'   similar approaches.
+#' @inheritParams checkmate::assert_factor
+#' @param (`integer`)\cr minimum number of factor levels. Default is `1`.
 #' @param ... a collection of objects to test.
 #' @name assertions
 NULL
@@ -80,9 +85,6 @@ check_df_with_variables <- function(df, variables, na_level = NULL) {
 #' @describeIn assertions Check whether `df` is a data frame with the analysis `variables`.
 #'   Please notice how this produces an error when not all variables are present in the
 #'   data.frame while the opposite is not required.
-#' @param na_level (`string`)\cr the string user has been using to represent NA or
-#'   missing data. For `NA` values please consider using directly `base::is.na` or
-#'   similar approaches.
 #'
 #' @examples
 #' # Check whether `df` contains the analysis `variables`.
@@ -125,7 +127,10 @@ assert_df_with_variables <- checkmate::makeAssertionFunction(check_df_with_varia
 check_valid_factor <- function(x,
                                min.levels = 1,
                                max.levels = NULL,
-                               any.missing = TRUE) {
+                               null.ok = TRUE, # nolint
+                               any.missing = TRUE, # nolint
+                               n.levels = NULL, # nolint
+                               len = NULL) {
   # checks on levels insertion
   checkmate::assert_int(min.levels, lower = 1)
   # no check of max.levels if it is NULL
@@ -134,11 +139,11 @@ check_valid_factor <- function(x,
   }
   # main factor check
   res <- checkmate::check_factor(x,
-    empty.levels.ok = TRUE,
     min.levels = min.levels,
-    null.ok = TRUE,
+    null.ok = null.ok,
     max.levels = max.levels,
-    any.missing = any.missing
+    any.missing = any.missing,
+    n.levels = n.levels
   )
   # no empty strings allowed
   if (isTRUE(res)) {
@@ -148,14 +153,12 @@ check_valid_factor <- function(x,
 }
 #' @describeIn assertions Check whether `x` is a valid factor (has levels and no empty string levels).
 #'   Note that `NULL` and `NA` elements are allowed.
-#' @param min.levels Minimum number of levels for `x`.
-#' @param max.levels Maximum number of levels for `x`.
-#' @param any.missing Default is `TRUE`, allowing missing values (`NA`).
 #'
 #' @examples
 #' # Check whether `x` is a valid factor.
-#' tern:::assert_valid_factor(factor(c("a", "b")))
 #' tern:::assert_valid_factor(factor(c("a", NULL)))
+#' tern:::assert_valid_factor(factor(c("a", "b")))
+#' tern:::assert_valid_factor(factor(c("a", "b")), len = 2)
 #' tern:::assert_valid_factor(factor(c("a", NA)), any.missing = TRUE)
 #' tern:::assert_valid_factor(factor("A", levels = c("A", "B")))
 #'
@@ -177,7 +180,7 @@ check_df_with_factors <- function(df,
                                   variables,
                                   min.levels = 1,
                                   max.levels = NULL,
-                                  any.missing = TRUE,
+                                  any.missing = TRUE, # nolint
                                   na_level = NULL) {
   res <- check_df_with_variables(df, variables, na_level)
   # checking if all the columns specified by variables are valid factors
@@ -208,12 +211,6 @@ check_df_with_factors <- function(df,
 #' @describeIn assertions Check whether `df` is a data frame where the analysis `variables`
 #'   are all factors. Note that the creation of `NA` by direct call of `factor()` will
 #'   trim `NA` levels out of the vector list itself.
-#' @param min.levels Minimum number of levels for `x`.
-#' @param max.levels Maximum number of levels for `x`.
-#' @param any.missing Default is `TRUE`, allowing missing values (`NA`).
-#' @param na_level (`string`)\cr the string user has been using to represent NA or
-#'   missing data. For `NA` values please consider using directly `base::is.na` or
-#'   similar approaches.
 #'
 #' @examples
 #' # Check whether `df` contains all factor analysis `variables`.

R/utils_factor.R

@@ -18,10 +18,8 @@
 #'
 #' combine_levels(x, c("e", "b"))
 combine_levels <- function(x, levels, new_level = paste(levels, collapse = "/")) {
-  stopifnot(
-    is.factor(x),
-    all(levels %in% levels(x))
-  )
+  checkmate::assert_factor(x)
+  checkmate::assert_subset(levels, levels(x))
 
   lvls <- levels(x)
 

R/utils_grid.R

@@ -36,7 +36,9 @@ stack_grobs <- function(...,
                         vp = NULL,
                         gp = NULL,
                         name = NULL) {
-  stopifnot(all(vapply(grobs, grid::is.grob, logical(1))))
+  checkmate::assert_true(
+    all(vapply(grobs, grid::is.grob, logical(1)))
+  )
 
   if (length(grobs) == 1) {
     return(grobs[[1]])
@@ -126,7 +128,9 @@ arrange_grobs <- function(..., # nolint
                           vp = NULL,
                           gp = NULL,
                           name = NULL) {
-  stopifnot(all(vapply(grobs, grid::is.grob, logical(1))))
+  checkmate::assert_true(
+    all(vapply(grobs, grid::is.grob, logical(1)))
+  )
 
   if (length(grobs) == 1) {
     return(grobs[[1]])