1425 feature request export various internal functions for usage in jj based sister package to nest tern (#1426)

# Pull Request

addresses #1425, export several internal functions

---------

Signed-off-by: Ilse <[email protected]>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: Davide Garolini <[email protected]>

Author: 3 people

NAMESPACE

@@ -46,6 +46,11 @@ export(append_varlabels)
 export(arrange_grobs)
 export(as.rtable)
 export(as_factor_keep_attributes)
+export(assert_df_with_factors)
+export(assert_df_with_variables)
+export(assert_proportion_value)
+export(check_diff_prop_ci)
+export(clogit_with_tryCatch)
 export(combine_counts)
 export(combine_groups)
 export(combine_levels)
@@ -132,6 +137,7 @@ export(g_km)
 export(g_lineplot)
 export(g_step)
 export(g_waterfall)
+export(get_covariates)
 export(get_formats_from_stats)
 export(get_indents_from_stats)
 export(get_labels_from_stats)
@@ -226,6 +232,7 @@ export(has_fractions_difference)
 export(imputation_rule)
 export(keep_content_rows)
 export(keep_rows)
+export(labels_or_names)
 export(labels_use_control)
 export(level_order)
 export(logistic_regression_cols)
@@ -244,6 +251,7 @@ export(prop_jeffreys)
 export(prop_strat_wilson)
 export(prop_wald)
 export(prop_wilson)
+export(range_noinf)
 export(reapply_varlabels)
 export(ref_group_position)
 export(rtable2gg)
@@ -262,6 +270,8 @@ export(s_odds_ratio)
 export(s_proportion)
 export(s_proportion_diff)
 export(s_summary)
+export(s_surv_timepoint)
+export(s_test_proportion_diff)
 export(sas_na)
 export(score_occurrences)
 export(score_occurrences_cols)

NEWS.md

@@ -32,6 +32,7 @@
 * Moved helper functions `h_tab_rsp_one_biomarker()` and `h_tab_surv_one_biomarker()` into `h_biomarkers_subgroups.R`.
 * Reorganized the utility documentation related to factors (`utils_factor.R`) into a single file.
 * Converted `as_factor_keep_attributes()` to an exported function.
+* Converted `assert_df_with_factors()`, `assert_df_with_variables()`, `assert_proportion_value()`, `check_diff_prop_ci()`, `clogit_with_tryCatch()`, `get_covariates()`, `labels_or_names()`, `range_noinf()` , `s_surv_timepoint()`, `s_test_proportion_diff()` to exported functions.
 * Removed internal function `ungroup_stats()` and replaced its usage with the `get_*_from_stats()` functions.
 * Removed `s_count_nonmissing()` as it is a non-repeated small and internal function.
 

R/prop_diff.R

@@ -326,13 +326,27 @@ estimate_proportion_diff <- function(lyt,
 
 #' Check proportion difference arguments
 #'
+#' @description `r lifecycle::badge("stable")`
+#'
 #' Verifies that and/or convert arguments into valid values to be used in the
 #' estimation of difference in responder proportions.
 #'
 #' @inheritParams prop_diff
 #' @inheritParams prop_diff_wald
 #'
-#' @keywords internal
+#' @examples
+#' # example code
+#' ## "Mid" case: 4/4 respond in group A, 1/2 respond in group B.
+#' nex <- 100 # Number of example rows
+#' dta <- data.frame(
+#'   "rsp" = sample(c(TRUE, FALSE), nex, TRUE),
+#'   "grp" = sample(c("A", "B"), nex, TRUE),
+#'   "f1" = sample(c("a1", "a2"), nex, TRUE),
+#'   "f2" = sample(c("x", "y", "z"), nex, TRUE),
+#'   stringsAsFactors = TRUE
+#' )
+#' check_diff_prop_ci(rsp = dta[["rsp"]], grp = dta[["grp"]], conf_level = 0.95)
+#' @export
 check_diff_prop_ci <- function(rsp,
                                grp,
                                strata = NULL,

R/prop_diff_test.R

@@ -26,7 +26,27 @@ NULL
 #' * `s_test_proportion_diff()` returns a named `list` with a single item `pval` with an attribute `label`
 #'   describing the method used. The p-value tests the null hypothesis that proportions in two groups are the same.
 #'
-#' @keywords internal
+#' @examples
+#'
+#' ## "Mid" case: 4/4 respond in group A, 1/2 respond in group B.
+#' nex <- 100 # Number of example rows
+#' dta <- data.frame(
+#'   "rsp" = sample(c(TRUE, FALSE), nex, TRUE),
+#'   "grp" = sample(c("A", "B"), nex, TRUE),
+#'   "f1" = sample(c("a1", "a2"), nex, TRUE),
+#'   "f2" = sample(c("x", "y", "z"), nex, TRUE),
+#'   stringsAsFactors = TRUE
+#' )
+#' s_test_proportion_diff(
+#'   df = subset(dta, grp == "A"),
+#'   .var = "rsp",
+#'   .ref_group = subset(dta, grp == "B"),
+#'   .in_ref_col = FALSE,
+#'   variables = NULL,
+#'   method = "chisq"
+#' )
+#'
+#' @export
 s_test_proportion_diff <- function(df,
                                    .var,
                                    .ref_group,

R/survival_timepoint.R

@@ -42,7 +42,25 @@ NULL
 #'   * `rate_ci`: Confidence interval for event free rate.
 #'   * `event_free_rate_3d`: Event-free rate (%) with Confidence interval.
 #'
-#' @keywords internal
+#' @examples
+#' library(dplyr)
+#'
+#' adtte_f <- tern_ex_adtte %>%
+#'   filter(PARAMCD == "OS") %>%
+#'   mutate(
+#'     AVAL = day2month(AVAL),
+#'     is_event = CNSR == 0
+#'   )
+#'
+#' s_surv_timepoint(
+#'   df = subset(adtte_f, ARMCD == "ARM A"),
+#'   .var = "AVAL",
+#'   is_event = "is_event",
+#'   time_point = c(10),
+#'   control = control_surv_timepoint()
+#' )
+#'
+#' @export
 s_surv_timepoint <- function(df,
                              .var,
                              time_point,

R/utils.R

@@ -1,5 +1,7 @@
 #' Re-implemented `range()` default S3 method for numerical objects
 #'
+#' @description `r lifecycle::badge("stable")`
+#'
 #' This function returns `c(NA, NA)` instead of `c(-Inf, Inf)` for zero-length data
 #' without any warnings.
 #'
@@ -9,7 +11,13 @@
 #'
 #' @return A 2-element vector of class `numeric`.
 #'
-#' @keywords internal
+#' @examples
+#' x <- rnorm(20, 1)
+#' range_noinf(x, na.rm = TRUE)
+#' range_noinf(rep(NA, 20), na.rm = TRUE)
+#' range(rep(NA, 20), na.rm = TRUE)
+#'
+#' @export
 range_noinf <- function(x, na.rm = FALSE, finite = FALSE) { # nolint
 
   checkmate::assert_numeric(x)
@@ -60,12 +68,17 @@ f_pval <- function(test_mean) {
 
 #' Utility function to return a named list of covariate names
 #'
+#' @description `r lifecycle::badge("stable")`
+#'
 #' @param covariates (`character`)\cr a vector that can contain single variable names (such as
 #'   `"X1"`), and/or interaction terms indicated by `"X1 * X2"`.
 #'
 #' @return A named `list` of `character` vector.
 #'
-#' @keywords internal
+#' @examples
+#' get_covariates(c("a * b", "c"))
+#'
+#' @export
 get_covariates <- function(covariates) {
   checkmate::assert_character(covariates)
   cov_vars <- unique(trimws(unlist(strsplit(covariates, "\\*"))))
@@ -434,7 +447,32 @@ reapply_varlabels <- function(x, varlabels, ...) {
   x
 }
 
-# Wrapper function of survival::clogit so that when model fitting failed, a more useful message would show
+#' Wrapper function of survival::clogit
+#'
+#' When model fitting failed, a more useful message would show.
+#'
+#' @param formula Model formula.
+#' @param data data frame.
+#' @param ... further parameters to be added to survival::clogit.
+#'
+#' @return When model fitting is successful, an object of class "clogit".\cr
+#' When model fitting failed, an error message is shown.
+#'
+#' @examples
+#' \dontrun{
+#' library(dplyr)
+#' adrs_local <- tern_ex_adrs %>%
+#'   dplyr::filter(ARMCD %in% c("ARM A", "ARM B")) %>%
+#'   dplyr::mutate(
+#'     RSP = dplyr::case_when(AVALC %in% c("PR", "CR") ~ 1, TRUE ~ 0),
+#'     ARMBIN = droplevels(ARMCD)
+#'   )
+#' dta <- adrs_local
+#' dta <- dta[sample(nrow(dta)), ]
+#' mod <- clogit_with_tryCatch(formula = RSP ~ ARMBIN * AGE + strata(STRATA1), data = dta)
+#' }
+#'
+#' @export
 clogit_with_tryCatch <- function(formula, data, ...) { # nolint
   tryCatch(
     survival::clogit(formula = formula, data = data, ...),

R/utils_checkmate.R

@@ -1,5 +1,7 @@
 #' Additional assertions to use with `checkmate`
 #'
+#' @description `r lifecycle::badge("stable")`
+#'
 #' Additional assertion functions which can be used together with the `checkmate` package.
 #'
 #' @inheritParams checkmate::assert_factor
@@ -31,7 +33,7 @@ check_list_of_variables <- function(x) {
   if (isTRUE(res)) {
     res <- checkmate::check_character(unlist(x), min.chars = 1)
   }
-  return(res)
+  res
 }
 #' @describeIn assertions Checks whether `x` is a valid list of variable names.
 #'   `NULL` elements of the list `x` are dropped with `Filter(Negate(is.null), x)`.
@@ -74,7 +76,17 @@ check_df_with_variables <- function(df, variables, na_level = NULL) {
 #'   Please notice how this produces an error when not all variables are present in the
 #'   data.frame while the opposite is not required.
 #'
-#' @keywords internal
+#' @examples
+#' x <- data.frame(
+#'   a = 1:10,
+#'   b = rnorm(10)
+#' )
+#' assert_df_with_variables(x, variables = list(a = "a", b = "b"))
+#'
+#' x <- ex_adsl
+#' assert_df_with_variables(x, list(a = "ARM", b = "USUBJID"))
+#'
+#' @export
 assert_df_with_variables <- checkmate::makeAssertionFunction(check_df_with_variables)
 
 check_valid_factor <- function(x,
@@ -146,12 +158,20 @@ check_df_with_factors <- function(df,
 #'   are all factors. Note that the creation of `NA` by direct call of `factor()` will
 #'   trim `NA` levels out of the vector list itself.
 #'
-#' @keywords internal
+#' @examples
+#' x <- ex_adsl
+#' assert_df_with_factors(x, list(a = "ARM"))
+#'
+#' @export
 assert_df_with_factors <- checkmate::makeAssertionFunction(check_df_with_factors)
 
 #' @describeIn assertions Check whether `x` is a proportion: number between 0 and 1.
 #'
-#' @keywords internal
+#' @examples
+#' assert_proportion_value(0.95)
+#' assert_proportion_value(1.0, include_boundaries = TRUE)
+#'
+#' @export
 assert_proportion_value <- function(x, include_boundaries = FALSE) {
   checkmate::assert_number(x, lower = 0, upper = 1)
   checkmate::assert_flag(include_boundaries)

R/utils_rtables.R

@@ -221,14 +221,23 @@ h_col_indices <- function(table_tree, col_names) {
 
 #' Labels or names of list elements
 #'
-#' Internal helper function for working with nested statistic function results which typically
+#' Helper function for working with nested statistic function results which typically
 #' don't have labels but names that we can use.
 #'
 #' @param x (`list`)\cr a list.
 #'
 #' @return A `character` vector with the labels or names for the list elements.
 #'
-#' @keywords internal
+#' @examples
+#' x <- data.frame(
+#'   a = 1:10,
+#'   b = rnorm(10)
+#' )
+#' labels_or_names(x)
+#' var_labels(x) <- c(b = "Label for b", a = NA)
+#' labels_or_names(x)
+#'
+#' @export
 labels_or_names <- function(x) {
   checkmate::assert_multi_class(x, c("data.frame", "list"))
   labs <- sapply(x, obj_label)

_pkgdown.yml

@@ -63,6 +63,8 @@ reference:
       - -analyze_functions
       - -estimate_coef
       - -summarize_functions
+      - s_surv_timepoint
+      - s_test_proportion_diff
 
   - title: Model-Specific Functions
     desc: These functions help with fitting or extracting results from specific
@@ -75,6 +77,8 @@ reference:
       - starts_with("logistic_")
       - starts_with("tidy.")
       - univariate
+      - get_covariates
+      - clogit_with_tryCatch
 
   - title: Graphs
     desc: These function create graphical type output.
@@ -107,6 +111,7 @@ reference:
       - -h_tab_one_biomarker
       - -h_xticks
       - -prop_diff
+      - check_diff_prop_ci
 
   - title: rtables Helper Functions
     desc: These functions help to work with the `rtables` package and may be
@@ -128,12 +133,14 @@ reference:
       - to_string_matrix
       - groups_list_to_df
       - utils_split_funs
+      - labels_or_names
 
   - title: rtables Formatting Functions
     desc: These functions provide customized formatting rules to work with the
           `rtables` package.
     contents:
       - starts_with("format_")
+      - range_noinf
 
   - title: rtables Scoring Functions
     desc: These functions can help with table sorting.

inst/WORDLIST

@@ -35,11 +35,14 @@ TLG
 TLGs
 biomarker
 biomarkers
+clogit
+coercible
 de
 funder
 layouting
 pharmacokinetic
 pre
+repo
 responder
 responders
 subtable