diff --git a/DESCRIPTION b/DESCRIPTION index 4e81aa330..7cff6637f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cardx Title: Extra Analysis Results Data Utilities -Version: 0.1.0.9042 +Version: 0.1.0.9051 Authors@R: c( person("Daniel", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre")), person("Abinaya", "Yogasekaram", , "abinaya.yogasekaram@contractors.roche.com", role = "aut"), @@ -18,7 +18,7 @@ BugReports: https://github.com/insightsengineering/cardx/issues Depends: R (>= 4.1) Imports: - cards (>= 0.1.0.9014), + cards (>= 0.1.0.9032), cli (>= 3.6.1), dplyr (>= 1.1.2), glue (>= 1.6.2), @@ -33,13 +33,13 @@ Suggests: effectsize (>= 0.8.8), emmeans (>= 1.7.3), geepack (>= 1.3.2), - ggsurvfit (>= 1.0.0), + ggsurvfit (>= 1.1.0), lme4 (>= 1.1-31), parameters (>= 0.20.2), smd (>= 0.6.6), spelling, survey (>= 4.1), - survival (>= 3.2-11), + survival (>= 3.6-4), testthat (>= 3.2.0), withr (>= 2.5.0) Remotes: diff --git a/NAMESPACE b/NAMESPACE index d1e1abdba..ca9bbf793 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(ard_attributes,survey.design) +S3method(ard_continuous,survey.design) S3method(ard_regression,default) S3method(ard_stats_anova,anova) S3method(ard_stats_anova,data.frame) @@ -9,13 +11,18 @@ export("%>%") export(all_of) export(any_of) export(ard_aod_wald_test) +export(ard_attributes) export(ard_car_anova) export(ard_car_vif) +export(ard_categorical) +export(ard_continuous) +export(ard_dichotomous) export(ard_effectsize_cohens_d) export(ard_effectsize_hedges_g) export(ard_effectsize_paired_cohens_d) export(ard_effectsize_paired_hedges_g) export(ard_emmeans_mean_difference) +export(ard_missing) export(ard_proportion_ci) export(ard_regression) export(ard_regression_basic) @@ -33,19 +40,22 @@ export(ard_stats_paired_t_test) export(ard_stats_paired_wilcox_test) export(ard_stats_prop_test) export(ard_stats_t_test) +export(ard_stats_t_test_onesample) export(ard_stats_wilcox_test) +export(ard_stats_wilcox_test_onesample) export(ard_survey_svychisq) -export(ard_survey_svycontinuous) export(ard_survey_svyranktest) export(ard_survey_svyttest) export(ard_survival_survdiff) export(ard_survival_survfit) +export(ard_survival_survfit_diff) export(bt) export(bt_strip) export(construct_model) export(contains) export(ends_with) export(everything) +export(is_binary) export(last_col) export(matches) export(num_range) @@ -60,6 +70,11 @@ export(reformulate2) export(starts_with) export(where) import(rlang) +importFrom(cards,ard_attributes) +importFrom(cards,ard_categorical) +importFrom(cards,ard_continuous) +importFrom(cards,ard_dichotomous) +importFrom(cards,ard_missing) importFrom(dplyr,"%>%") importFrom(dplyr,across) importFrom(dplyr,all_of) diff --git a/NEWS.md b/NEWS.md index 2459929a0..d11bcea46 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# cardx 0.1.0.9042 +# cardx 0.1.0.9051 ### Breaking Changes @@ -18,24 +18,30 @@ ard_moodtest() -> ard_stats_mood_test() ### New Features +* The `ard_proportion_ci(value)` argument has been added. Previously, only binary variables (0/1 or TRUE/FALSE) could be summarized. When a value is not supplied, each level of the variable is summarized independently. By default, binary variables will have the 1/TRUE level summarized. + * Added the following functions for calculating Analysis Results Data (ARD). - `ard_stats_aov()` for calculating ANOVA results using `stats::aov()`. (#3) - `ard_stats_anova()` for calculating ANOVA results using `stats::anova()`. (#12) - `ard_stats_mcnemar_test_long()` for McNemar's test from long data using `stats::mcnemar.test()`. - `ard_aod_wald_test()` for calculating Wald Tests for regression models using `aod::wald.test()`. (#84) - `ard_car_anova()` for calculating ANOVA results using `car::Anova()`. (#3) + - `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) - `ard_stats_oneway_test()` for calculating ANOVA results using `stats::oneway.test()`. (#3) - `ard_effectsize_cohens_d()`, `ard_effectsize_paired_cohens_d()`, `ard_effectsize_hedges_g()`, and `ard_effectsize_paired_hedges_g()` for standardized differences using `effectsize::cohens_d()` and `effectsize::hedges_g()`. (#50) - - `ard_stats_prop_test()` for tests of proportions using `stats::prop.test()`. (#64) - - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) + - `ard_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34) - `ard_smd_smd()` for calculating standardized mean differences using `smd::smd()`. (#4) - `ard_survival_survfit()` for survival analyses using `survival::survfit()`. (#43) - - `ard_survey_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) + - `ard_continuous.survey.design()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) + - `ard_attributes.survey.design()` for summarizing labels and attributes from weighted/survey data using many functions from the {survey} package. - `ard_survey_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72) - `ard_survey_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70) - `ard_survey_svyranktest()` for weighted/survey rank tests using `survey::svyranktest()`. (#71) - - `ard_car_vif()` for calculating the variance inflation factor using `car::vif()`. (#10) - - `ard_emmeans_mean_difference()` for calculating the least-squares mean differences using the {emmeans} package. (#34) + - `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113) + - `ard_stats_prop_test()` for tests of proportions using `stats::prop.test()`. (#64) + - `ard_stats_t_test_onesample()` for calculating one-sample results. + - `ard_stats_wilcox_test_onesample()` for calculating one-sample results. + - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) * Updated functions `ard_stats_t_test()`, `ard_stats_paired_t_test()`, `ard_stats_wilcox_test()`, `ard_stats_paired_wilcox_test()`, `ard_stats_chisq_test()`, `ard_stats_fisher_test()`, `ard_stats_kruskal_test()`, `ard_stats_mcnemar_test()`, and `ard_stats_mood_test()` to accept multiple variables at once. Independent tests are calculated for each variable. The `variable` argument is renamed to `variables`. (#77) @@ -43,7 +49,7 @@ ard_moodtest() -> ard_stats_mood_test() * Imported cli call environment functions from `https://github.com/ddsjoberg/standalone/blob/main/R/standalone-cli_call_env.R` and implemented `set_cli_abort_call` in user-facing functions. (#111) -* Added `ard_survival_survdiff()` for creating results from `survival::survdiff()`. (#113) +* Added model construction helpers, `construct_model()`, `reformulate2()`, `bt()`, and `bt_strip()`. # cardx 0.1.0 diff --git a/R/ard_attributes.survey.design.R b/R/ard_attributes.survey.design.R new file mode 100644 index 000000000..b3f069768 --- /dev/null +++ b/R/ard_attributes.survey.design.R @@ -0,0 +1,37 @@ +#' ARD Attributes +#' +#' @description +#' Add variable attributes to an ARD data frame. +#' - The `label` attribute will be added for all columns, and when no label +#' is specified and no label has been set for a column using the `label=` argument, +#' the column name will be placed in the label statistic. +#' - The `class` attribute will also be returned for all columns. +#' - Any other attribute returned by `attributes()` will also be added, e.g. factor levels. +#' +#' @rdname ard_attributes +#' @param data (`survey.design`)\cr +#' a design object often created with [`survey::svydesign()`]. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' variables to include +#' @param label (named `list`)\cr +#' named list of variable labels, e.g. `list(cyl = "No. Cylinders")`. +#' Default is `NULL` +#' @inheritParams rlang::args_dots_empty +#' +#' @return an ARD data frame of class 'card' +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx")) +#' data(api, package = "survey") +#' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) +#' +#' ard_attributes( +#' data = dclus1, +#' variables = c(sname, dname), +#' label = list(sname = "School Name", dname = "District Name") +#' ) +ard_attributes.survey.design <- function(data, variables = everything(), label = NULL, ...) { + set_cli_abort_call() + + cards::ard_attributes(data = data[["variables"]], variables = {{ variables }}, label = label, ...) +} diff --git a/R/ard_survey_svycontinuous.R b/R/ard_continuous.survey.design.R similarity index 94% rename from R/ard_survey_svycontinuous.R rename to R/ard_continuous.survey.design.R index 16d51fd5d..e96def3b5 100644 --- a/R/ard_survey_svycontinuous.R +++ b/R/ard_continuous.survey.design.R @@ -23,6 +23,7 @@ #' the list element is either a named list or a list of formulas defining the #' statistic labels, e.g. `everything() ~ list(mean = "Mean", sd = "SD")` or #' `everything() ~ list(mean ~ "Mean", sd ~ "SD")`. +#' @inheritParams rlang::args_dots_empty #' #' @section statistic argument: #' @@ -38,16 +39,18 @@ #' data(api, package = "survey") #' dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) #' -#' ard_survey_svycontinuous( +#' ard_continuous( #' data = dclus1, #' variables = api00, #' by = stype #' ) -ard_survey_svycontinuous <- function(data, variables, by = NULL, - statistic = everything() ~ c("median", "p25", "p75"), - fmt_fn = NULL, - stat_label = NULL) { +ard_continuous.survey.design <- function(data, variables, by = NULL, + statistic = everything() ~ c("median", "p25", "p75"), + fmt_fn = NULL, + stat_label = NULL, + ...) { set_cli_abort_call() + check_dots_empty() # check installed packages --------------------------------------------------- check_pkg_installed(pkg = "survey", reference_pkg = "cardx") @@ -68,7 +71,7 @@ ard_survey_svycontinuous <- function(data, variables, by = NULL, ) cards::fill_formula_selectors( data$variables[variables], - statistic = formals(ard_survey_svycontinuous)[["statistic"]] |> eval() + statistic = formals(asNamespace("cardx")[["ard_continuous.survey.design"]])[["statistic"]] |> eval() ) cards::check_list_elements( x = statistic, @@ -190,7 +193,7 @@ accepted_svy_stats <- function(expand_quantiles = TRUE) { else if (stat_name %in% "max") args <- list(FUN = \(x, design, na.rm, ...) max(design$variables[[all.vars(x)]], na.rm = na.rm)) # define functions for the quantiles else if (stat_name %in% c("median", paste0("p", 0:100))) { - quantile <- ifelse(stat_name %in% "median", 0.5, substr(stat_name, 2, nchar(stat_name)) |> as.numeric() %>% `/`(100)) + quantile <- ifelse(stat_name %in% "median", 0.5, as.numeric(substr(stat_name, 2, nchar(stat_name))) / 100) # univariate results are returned in a different format from stratified. args <- if (is_empty(by)) list(FUN = \(...) survey::svyquantile(...)[[1]], quantiles = quantile) diff --git a/R/ard_emmeans_mean_difference.R b/R/ard_emmeans_mean_difference.R index 86af2a44b..ac6fdff7a 100644 --- a/R/ard_emmeans_mean_difference.R +++ b/R/ard_emmeans_mean_difference.R @@ -70,7 +70,7 @@ ard_emmeans_mean_difference <- function(data, formula, method, # construct primary model ---------------------------------------------------- mod <- construct_model( - x = data, formula = formula, method = method, + data = data, formula = formula, method = method, method.args = {{ method.args }}, package = package, env = caller_env() ) diff --git a/R/ard_proportion_ci.R b/R/ard_proportion_ci.R index dad57e5ee..10ae04b0f 100644 --- a/R/ard_proportion_ci.R +++ b/R/ard_proportion_ci.R @@ -18,23 +18,35 @@ #' See `?proportion_ci` for details. #' @param strata,weights,max.iterations arguments passed to `proportion_ci_strat_wilson()`, #' when `method='strat_wilson'` +#' @param value ([`formula-list-selector`][syntax])\cr +#' function will calculate the CIs for all levels of the variables specified. +#' Use this argument to instead request only a single level by summarized. +#' Default is `list(where(is_binary) ~ 1L, where(is.logical) ~ TRUE)`, where +#' columns coded as `0`/`1` and `TRUE`/`FALSE` will summarize the `1` and `TRUE` levels. #' #' @return an ARD data frame #' @export #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' # compute CI for binary variables #' ard_proportion_ci(mtcars, variables = c(vs, am), method = "wilson") -ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data), - conf.level = 0.95, - strata, - weights = NULL, - max.iterations = 10, +#' +#' # compute CIs for each level of a categorical variable +#' ard_proportion_ci(mtcars, variables = cyl, method = "jeffreys") +ard_proportion_ci <- function(data, + variables, + by = dplyr::group_vars(data), method = c( "waldcc", "wald", "clopper-pearson", "wilson", "wilsoncc", "strat_wilson", "strat_wilsoncc", "agresti-coull", "jeffreys" - )) { + ), + conf.level = 0.95, + value = list(where(is_binary) ~ 1L, where(is.logical) ~ TRUE), + strata = NULL, + weights = NULL, + max.iterations = 10) { set_cli_abort_call() # check installed packages --------------------------------------------------- @@ -47,8 +59,43 @@ ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data), cards::process_selectors(data, strata = strata) check_scalar(strata) } + cards::process_formula_selectors( + data[variables], + value = value + ) # calculate confidence intervals --------------------------------------------- + map( + variables, + function(variable) { + levels <- .unique_values_sort(data, variable = variable, value = value[[variable]]) + + .calculate_ard_proportion( + data = .as_dummy(data, variable = variable, levels = levels, by = by, strata = strata), + variables = c(everything(), -all_of(c(by, strata))), + by = all_of(by), + method = method, + conf.level = conf.level, + strata = strata, + weights = weights, + max.iterations = max.iterations + ) %>% + # merge in the variable levels + dplyr::left_join( + dplyr::select(., "variable") |> + dplyr::distinct() |> + dplyr::mutate(variable_level = as.list(.env$levels)), + by = "variable" + ) |> + # rename variable column + dplyr::mutate(variable = .env$variable) |> + dplyr::relocate("variable_level", .after = "variable") + } + ) |> + dplyr::bind_rows() +} + +.calculate_ard_proportion <- function(data, variables, by, method, conf.level, strata, weights, max.iterations) { cards::ard_complex( data = data, variables = {{ variables }}, @@ -85,3 +132,35 @@ ard_proportion_ci <- function(data, variables, by = dplyr::group_vars(data), context = "proportion_ci" ) } + +.unique_values_sort <- function(data, variable, value = NULL) { + unique_levels <- + # styler: off + if (is.logical(data[[variable]])) c(TRUE, FALSE) + else if (is.factor(data[[variable]])) factor(levels(data[[variable]]), levels = levels(data[[variable]])) + else unique(data[[variable]]) |> sort() + # styler: on + + if (!is_empty(value) && !value %in% unique_levels) { + cli::cli_warn( + c("A value of {.code value={.val {value}}} for variable {.val {variable}} + was passed, but is not one of the observed levels: {.val {unique_levels}}.", + i = "This may be an error.", + i = "If value is a valid, convert variable to factor with all levels specified to avoid this message." + ) + ) + } + if (!is_empty(value)) { + unique_levels <- value + } + + unique_levels +} + +.as_dummy <- function(data, variable, levels, by, strata) { + # define dummy variables and return tibble + map(levels, ~ data[[variable]] == .x) |> + set_names(paste0("this_is_not_a_column_name_anyone_would_choose_", variable, "_", levels, "...")) %>% + {dplyr::tibble(!!!.)} |> # styler: off + dplyr::bind_cols(data[c(by, strata)]) +} diff --git a/R/ard_stats_anova.R b/R/ard_stats_anova.R index 1019d7757..fed73f8bd 100644 --- a/R/ard_stats_anova.R +++ b/R/ard_stats_anova.R @@ -122,7 +122,7 @@ ard_stats_anova.data.frame <- function(x, lapply( formulas, function(formula) { - construct_model(x = x, formula = formula, method = method, method.args = {{ method.args }}, package = package) + construct_model(data = x, formula = formula, method = method, method.args = {{ method.args }}, package = package) } ) diff --git a/R/ard_stats_t_test_onesample.R b/R/ard_stats_t_test_onesample.R new file mode 100644 index 000000000..1a419b21a --- /dev/null +++ b/R/ard_stats_t_test_onesample.R @@ -0,0 +1,71 @@ +#' ARD one-sample t-test +#' +#' @description +#' Analysis results data for one-sample t-tests. +#' Result may be stratified by including the `by` argument. +#' +#' @param data (`data.frame`)\cr +#' a data frame. See below for details. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column names to be analyzed. Independent t-tests will be computed for +#' each variable. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' optional column name to stratify results by. +#' @inheritParams ard_stats_t_test +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' cards::ADSL |> +#' ard_stats_t_test_onesample(by = ARM, variables = AGE) +ard_stats_t_test_onesample <- function(data, variables, by = dplyr::group_vars(data), conf.level = 0.95, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed("broom", reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_data_frame(data) + data <- dplyr::ungroup(data) + cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}) + check_scalar_range(conf.level, range = c(0, 1)) + + # if no variables selected, return empty tibble ------------------------------ + if (is_empty(variables)) { + return(dplyr::tibble()) + } + + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = all_of(variables) ~ list(t_test_onesample = \(x) stats::t.test(x = x, conf.level = conf.level, ...) |> broom::tidy()) + ) |> + cards::bind_ard( + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = + all_of(variables) ~ + list(conf.level = \(x) { + formals(asNamespace("stats")[["t.test.default"]])["mu"] |> + utils::modifyList(list(conf.level = conf.level, ...)) + }) + ) + ) |> + dplyr::select(-"stat_label") |> + dplyr::left_join( + .df_ttest_stat_labels(by = NULL), + by = "stat_name" + ) |> + dplyr::mutate( + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name), + context = "stats_t_test_onesample", + ) |> + cards::tidy_ard_row_order() |> + cards::tidy_ard_column_order() +} diff --git a/R/ard_stats_wilcox_test_onesample.R b/R/ard_stats_wilcox_test_onesample.R new file mode 100644 index 000000000..88885fd0e --- /dev/null +++ b/R/ard_stats_wilcox_test_onesample.R @@ -0,0 +1,72 @@ +#' ARD one-sample Wilcox Rank-sum +#' +#' @description +#' Analysis results data for one-sample Wilcox Rank-sum. +#' Result may be stratified by including the `by` argument. +#' +#' @param data (`data.frame`)\cr +#' a data frame. See below for details. +#' @param variables ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column names to be analyzed. Independent Wilcox Rank-sum tests will be computed for +#' each variable. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' optional column name to stratify results by. +#' @inheritParams ard_stats_wilcox_test +#' +#' @return ARD data frame +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx")) +#' cards::ADSL |> +#' ard_stats_wilcox_test_onesample(by = ARM, variables = AGE) +ard_stats_wilcox_test_onesample <- function(data, variables, by = dplyr::group_vars(data), conf.level = 0.95, ...) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed("broom", reference_pkg = "cardx") + + # check/process inputs ------------------------------------------------------- + check_not_missing(data) + check_not_missing(variables) + check_data_frame(data) + data <- dplyr::ungroup(data) + cards::process_selectors(data, by = {{ by }}, variables = {{ variables }}) + check_scalar_range(conf.level, range = c(0, 1)) + + # if no variables selected, return empty tibble ------------------------------ + if (is_empty(variables)) { + return(dplyr::tibble()) + } + + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = all_of(variables) ~ list(t_test_onesample = \(x) stats::wilcox.test(x = x, conf.level = conf.level, ...) |> broom::tidy()) + ) |> + cards::bind_ard( + cards::ard_continuous( + data = data, + variables = all_of(variables), + by = all_of(by), + statistic = + all_of(variables) ~ + list(conf.level = \(x) { + formals(asNamespace("stats")[["wilcox.test.default"]])[c("mu", "exact", "conf.int", "tol.root", "digits.rank")] |> + utils::modifyList(list(conf.level = conf.level, ...)) |> + compact() + }) + ) + ) |> + dplyr::select(-"stat_label") |> + dplyr::left_join( + .df_ttest_stat_labels(by = NULL), + by = "stat_name" + ) |> + dplyr::mutate( + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name), + context = "stats_wilcox_test_onesample", + ) |> + cards::tidy_ard_row_order() |> + cards::tidy_ard_column_order() +} diff --git a/R/ard_survival_survfit.R b/R/ard_survival_survfit.R index 9a30adf5f..e430eedc0 100644 --- a/R/ard_survival_survfit.R +++ b/R/ard_survival_survfit.R @@ -111,6 +111,8 @@ ard_survival_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { #' #' @inheritParams cards::tidy_as_ard #' @inheritParams ard_survival_survfit +#' @param start.time (`numeric`)\cr +#' default starting time. See [survival::survfit0()] for more details. #' #' @return a `tibble` #' @@ -119,42 +121,39 @@ ard_survival_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { #' cardx:::.process_survfit_time(times = c(60, 180), type = "risk") #' #' @keywords internal -.process_survfit_time <- function(x, times, type) { - # tidy survfit results - tidy_x <- broom::tidy(x) +.process_survfit_time <- function(x, times, type, start.time = NULL) { + # add start time + min_time <- min(x$time) + if (is.null(start.time) && min_time < 0) { + cli::cli_inform(paste( + "The {.arg start.time} argument has not been set and negative times have been observed. Please set start", + "time via the {.arg start.time} argument, otherwise the minimum observed time will be used by default." + )) + start.time <- min_time + } else if (is.null(start.time)) { + start.time <- 0 + } + x <- survival::survfit0(x, start.time) %>% + summary(times) # process competing risks/multi-state models - multi_state <- inherits(x, "survfitms") + multi_state <- inherits(x, "summary.survfitms") - if (multi_state == TRUE) { + if (multi_state) { # selecting state to show - state <- setdiff(unique(tidy_x$state), "(s0)")[[1]] + state <- setdiff(unique(x$states), "(s0)")[[1]] cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") - tidy_x <- dplyr::filter(tidy_x, .data$state == .env$state) + x$n.risk <- x$n.risk[, 1] + ms_cols <- c("pstate", "std.err", "upper", "lower") + state_col <- which(colnames(x$pstate) == state) + x[ms_cols] <- lapply(x[ms_cols], function(m) m[, state_col]) + x$surv <- x$pstate } - # adding time 0 to data frame - tidy_x <- tidy_x %>% - # make strata a fct to preserve ordering - dplyr::mutate(dplyr::across(dplyr::any_of("strata"), ~ factor(., levels = unique(.)))) %>% - # if CI is missing and SE is 0, use estimate as the CI - dplyr::mutate_at( - dplyr::vars("conf.high", "conf.low"), - ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) - ) %>% - dplyr::select(dplyr::any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% - # add data for time 0 - dplyr::bind_rows( - dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% - dplyr::slice(1) %>% - dplyr::mutate( - time = 0, - estimate = ifelse(multi_state, 0, 1), - conf.low = ifelse(multi_state, 0, 1), - conf.high = ifelse(multi_state, 0, 1) - ) - ) %>% - dplyr::ungroup() + # tidy survfit results + x_cols <- intersect(names(x), c("time", "n.risk", "surv", "std.err", "upper", "lower", "strata")) + tidy_x <- data.frame(x[x_cols]) %>% + dplyr::rename(estimate = "surv", std.error = "std.err", conf.high = "upper", conf.low = "lower") strat <- "strata" %in% names(tidy_x) @@ -182,16 +181,7 @@ ard_survival_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { } df_stat <- df_stat %>% - # if user-specifed time is unobserved, fill estimate with previous value dplyr::arrange(.data$time) %>% - dplyr::group_by_at(dplyr::vars(dplyr::any_of("strata"))) %>% - tidyr::fill( - "estimate", "conf.high", "conf.low", "time_max", - .direction = "down" - ) %>% - dplyr::ungroup() %>% - # keep only user-specified times - dplyr::filter(!is.na(.data$col_name)) %>% # if user-specified time is after max time, make estimate NA dplyr::mutate_at( dplyr::vars("estimate", "conf.high", "conf.low"), @@ -236,7 +226,7 @@ ard_survival_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { as.data.frame() %>% set_names(c("estimate", "conf.low", "conf.high")) %>% dplyr::mutate(strata = row.names(.)) %>% - dplyr::select(dplyr::any_of(c("strata", "estimate", "conf.low", "conf.high"))) %>% + dplyr::select(dplyr::any_of(c("n.risk", "strata", "estimate", "std.error", "conf.low", "conf.high"))) %>% dplyr::mutate(prob = .x) ) %>% dplyr::bind_rows() %>% @@ -293,10 +283,10 @@ extract_multi_strata <- function(x, df_stat) { ret <- tidy_survfit %>% dplyr::mutate(dplyr::across( - dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) + dplyr::any_of(c("n.risk", "estimate", "std.error", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% tidyr::pivot_longer( - cols = dplyr::any_of(c("estimate", "conf.high", "conf.low")), + cols = dplyr::any_of(c("n.risk", "estimate", "std.error", "conf.high", "conf.low")), names_to = "stat_name", values_to = "stat" ) %>% @@ -342,7 +332,9 @@ extract_multi_strata <- function(x, df_stat) { .df_survfit_stat_labels <- function() { dplyr::tribble( ~stat_name, ~stat_label, + "n.risk", "Number of Subjects at Risk", "estimate", "Survival Probability", + "std.error", "Standard Error (untransformed)", "conf.low", "CI Lower Bound", "conf.high", "CI Upper Bound", "conf.level", "CI Confidence Level", diff --git a/R/ard_survival_survfit_diff.R b/R/ard_survival_survfit_diff.R new file mode 100644 index 000000000..5700c2e5c --- /dev/null +++ b/R/ard_survival_survfit_diff.R @@ -0,0 +1,121 @@ +#' ARD Survival Differences +#' +#' Calculate differences in the Kaplan-Meier estimator of survival using the +#' results from [`survival::survfit()`]. +#' +#' @param x (`survift`)\cr +#' object of class `'survfit'` typically created with [`survival::survfit()`] +#' @param conf.level (scalar `numeric`)\cr +#' confidence level for confidence interval. Default is `0.95`. +#' @inheritParams ard_survival_survfit +#' +#' @return an ARD data frame of class 'card' +#' @export +#' +#' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "ggsurvfit"), reference_pkg = "cardx")) +#' library(ggsurvfit) +#' library(survival) +#' +#' survfit(Surv_CNSR() ~ TRTA, data = cards::ADTTE) |> +#' ard_survival_survfit_diff(times = c(25, 50)) +ard_survival_survfit_diff <- function(x, times, conf.level = 0.95) { + set_cli_abort_call() + + # check installed packages --------------------------------------------------- + check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") + check_not_missing(x) + check_not_missing(times) + check_class(x, "survfit") + + if (inherits(x, c("survfitms", "survfitcox"))) { + cli::cli_abort( + "Argument {.arg x} cannot be class {.cls {c('survfitms', 'survfitcox')}}.", + call = get_cli_abort_call() + ) + } + check_scalar_range(conf.level, range = c(0, 1)) + check_length( + as.list(x$call)[["formula"]] |> stats::as.formula() |> stats::terms() |> attr("term.labels"), + length = 1L, + message = "The {.cls survfit} object passed in argument {.arg x} must be stratified by a single variable." + ) + if (length(x$strata) < 2) { + cli::cli_abort( + "The {.cls survfit} object's stratifying variable must have 2 or more levels.", + call = get_cli_abort_call() + ) + } + + # calculate the survival at the specified times + ard_survival_survfit <- + ard_survival_survfit(x = x, times = times) |> + dplyr::filter(.data$stat_name %in% c("estimate", "std.error")) |> + dplyr::select(-c("stat_label", "context", "fmt_fn")) + + # transform the survival ARD into a cards object with the survival difference + card <- + ard_survival_survfit %>% + {dplyr::left_join( # styler: off + # remove the first group from the data frame (this is our reference group) + dplyr::filter(., .by = cards::all_ard_groups(), dplyr::cur_group_id() > 1L) |> + dplyr::rename(stat1 = "stat"), + # merge the reference group data + dplyr::filter(., .by = cards::all_ard_groups(), dplyr::cur_group_id() == 1L) |> + dplyr::select(stat0 = "stat", everything(), -c("group1_level", "error", "warning")), + by = c("group1", "variable", "variable_level", "stat_name") + )} |> # styler: off + # reshape to put the stats that need to be combined on the same row + tidyr::pivot_wider( + id_cols = c("group1", "group1_level", "variable", "variable_level"), + names_from = "stat_name", + values_from = c("stat0", "stat1"), + values_fn = unlist + ) |> + # calcualte the primary statistics to return + dplyr::mutate( + # reference level + reference_level = ard_survival_survfit[["group1_level"]][1], + # short description of method + method = "Survival Difference (Z-test)", + # survival difference + estimate = .data$stat0_estimate - .data$stat1_estimate, + # survival difference standard error + std.error = sqrt(.data$stat0_std.error^2 + .data$stat1_std.error^2), + # Z test statistic + statistic = .data$estimate / .data$std.error, + # confidence limits of the survival difference + conf.low = .data$estimate - .data$std.error * stats::qnorm(1 - (1 - .env$conf.level) / 2), + conf.high = .data$estimate + .data$std.error * stats::qnorm(1 - (1 - .env$conf.level) / 2), + # p-value for test where H0: no difference + p.value = 2 * (1 - stats::pnorm(abs(.data$statistic))), + across(c("reference_level", "estimate", "std.error", "statistic", "conf.low", "conf.high", "p.value", "method"), as.list) + ) |> + # reshape into the cards structure + dplyr::select(-starts_with("stat0_"), -starts_with("stat1_")) |> + tidyr::pivot_longer( + cols = -c(cards::all_ard_groups(), cards::all_ard_variables()), + names_to = "stat_name", + values_to = "stat" + ) + + # final prepping of the cards object ----------------------------------------- + card |> + dplyr::mutate( + warning = ard_survival_survfit[["warning"]][1], + error = ard_survival_survfit[["error"]][1], + fmt_fn = list(1L), + stat_label = + dplyr::case_when( + .data$stat_name %in% "estimate" ~ "Survival Difference", + .data$stat_name %in% "std.error" ~ "Survival Difference Standard Error", + .data$stat_name %in% "conf.low" ~ "CI Lower Bound", + .data$stat_name %in% "conf.high" ~ "CI Upper Bound", + .data$stat_name %in% "statistic" ~ "z statistic", + .data$stat_name %in% "p.value" ~ "p-value", + .default = .data$stat_name + ), + context = "survival_survfit_diff", + ) |> + cards::tidy_ard_column_order() %>% + structure(., class = c("card", class(.))) +} diff --git a/R/construction_helpers.R b/R/construction_helpers.R index 8ceeb1f49..6672b1e1f 100644 --- a/R/construction_helpers.R +++ b/R/construction_helpers.R @@ -13,18 +13,24 @@ #' #' - `bt_strip()`: Removes backticks from a string if it begins and ends with a backtick. #' -#' @param x +#' @param data #' - `construct_model.data.frame()` (`data.frame`) a data frame #' - `construct_model.survey.design()` (`survey.design`) a survey design object -#' - `bt()`/`bt_strip()` (`character`) character vector, typically of variable names +#' @param x (`character`)\cr +#' character vector, typically of variable names #' @param formula (`formula`)\cr #' a formula #' @param method (`string`)\cr -#' string naming the function to be called, e.g. `"glm"`. +#' string of function naming the function to be called, e.g. `"glm"`. #' If function belongs to a library that is not attached, the package name #' must be specified in the `package` argument. #' @param method.args (named `list`)\cr -#' named list of arguments that will be passed to `fn`. +#' named list of arguments that will be passed to `method`. +#' +#' Note that this list may contain non-standard evaluation components. +#' If you are wrapping this function in other functions, the argument +#' must be passed in a way that does not evaluate the list, e.g. +#' using rlang's embrace operator `{{ . }}`. #' @param package (`string`)\cr #' string of package name that will be temporarily loaded when function #' specified in `method` is executed. @@ -42,7 +48,7 @@ #' #' @examplesIf do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("withr", "lme4", "broom.helpers", "broom.mixed"), reference_pkg = "cardx")) #' construct_model( -#' x = mtcars, +#' data = mtcars, #' formula = am ~ mpg + (1 | vs), #' method = "glmer", #' method.args = list(family = binomial), @@ -51,7 +57,7 @@ #' broom.mixed::tidy() #' #' construct_model( -#' x = mtcars |> dplyr::rename(`M P G` = mpg), +#' data = mtcars |> dplyr::rename(`M P G` = mpg), #' formula = reformulate2(c("M P G", "cyl"), response = "hp"), #' method = "lm" #' ) |> @@ -61,13 +67,13 @@ NULL #' @rdname construction_helpers #' @export -construct_model <- function(x, ...) { +construct_model <- function(data, ...) { UseMethod("construct_model") } #' @rdname construction_helpers #' @export -construct_model.data.frame <- function(x, formula, method, method.args = list(), package = "base", env = caller_env(), ...) { +construct_model.data.frame <- function(data, formula, method, method.args = list(), package = "base", env = caller_env(), ...) { set_cli_abort_call() # check pkg installations ---------------------------------------------------- check_dots_empty() @@ -77,8 +83,8 @@ construct_model.data.frame <- function(x, formula, method, method.args = list(), check_class(formula, cls = "formula") check_not_missing(method) - check_string(method) - check_not_namespaced(method) + check_string_or_function(method) + if (is_string(method)) check_not_namespaced(method) # convert method.args to list of expressions (to account for NSE inputs) ----- method.args <- .as_list_of_exprs({{ method.args }}) @@ -86,14 +92,14 @@ construct_model.data.frame <- function(x, formula, method, method.args = list(), # build model ---------------------------------------------------------------- withr::with_namespace( package = package, - call2(.fn = method, formula = formula, data = x, !!!method.args) |> + call2(.fn = method, formula = formula, data = data, !!!method.args) |> eval_tidy(env = env) ) } #' @rdname construction_helpers #' @export -construct_model.survey.design <- function(x, formula, method, method.args = list(), package = "survey", env = caller_env(), ...) { +construct_model.survey.design <- function(data, formula, method, method.args = list(), package = "survey", env = caller_env(), ...) { set_cli_abort_call() # check pkg installations ---------------------------------------------------- check_dots_empty() @@ -103,8 +109,8 @@ construct_model.survey.design <- function(x, formula, method, method.args = list check_class(formula, cls = "formula") check_not_missing(method) - check_string(method) - check_not_namespaced(method) + check_string_or_function(method) + if (is_string(method)) check_not_namespaced(method) # convert method.args to list of expressions (to account for NSE inputs) ----- method.args <- .as_list_of_exprs({{ method.args }}) @@ -112,7 +118,7 @@ construct_model.survey.design <- function(x, formula, method, method.args = list # build model ---------------------------------------------------------------- withr::with_namespace( package = package, - call2(.fn = method, formula = formula, design = x, !!!method.args) |> + call2(.fn = method, formula = formula, design = data, !!!method.args) |> eval_tidy(env = env) ) } @@ -171,10 +177,27 @@ check_not_namespaced <- function(x, check_string(x, arg_name = arg_name, call = call, class = "check_not_namespaced") if (str_detect(x, "::")) { - c("Argument {.arg {arg_name}} cannot be namespaced.", - i = "Put the package name in the {.arg package} argument." - ) |> - cli::cli_abort(call = call, class = class) + cli::cli_abort( + "Argument {.arg {arg_name}} cannot be namespaced when passed as a {.cls string}.", + call = call, + class = class + ) + } + + invisible(x) +} + + +check_string_or_function <- function(x, + arg_name = rlang::caller_arg(x), + class = "check_string_or_function", + call = get_cli_abort_call()) { + if (!is.function(x) && !is_string(x)) { + cli::cli_abort( + c("Argument {.arg {arg_name}} must be a {.cls string} or {.cls function}."), + call = call, + class = class + ) } invisible(x) diff --git a/R/proportion_ci.R b/R/proportion_ci.R index 34aef53d2..cce2b9a4f 100644 --- a/R/proportion_ci.R +++ b/R/proportion_ci.R @@ -362,6 +362,13 @@ proportion_ci_strat_wilson <- function(x, compact() } +#' @describeIn proportion_ci Helper to determine if vector is binary (logical or 0/1) +#' +#' @export +is_binary <- function(x) { + is.logical(x) || (is_integerish(x) && is_empty(setdiff(x, c(0, 1, NA)))) +} + #' Helper Function for the Estimation of Stratified Quantiles #' #' This function wraps the estimation of stratified percentiles when we assume diff --git a/R/reexports.R b/R/reexports.R index a7ae12e44..adc647104 100644 --- a/R/reexports.R +++ b/R/reexports.R @@ -1,3 +1,24 @@ +# cards ------------------------------------------------------------------------ +#' @importFrom cards ard_continuous +#' @export +cards::ard_continuous + +#' @importFrom cards ard_categorical +#' @export +cards::ard_categorical + +#' @importFrom cards ard_dichotomous +#' @export +cards::ard_dichotomous + +#' @importFrom cards ard_missing +#' @export +cards::ard_missing + +#' @importFrom cards ard_attributes +#' @export +cards::ard_attributes + # dplyr ------------------------------------------------------------------------ #' @export #' @importFrom dplyr %>% diff --git a/README.Rmd b/README.Rmd index 8c2a55acf..9d8745150 100644 --- a/README.Rmd +++ b/README.Rmd @@ -5,7 +5,7 @@ editor_options: wrap: 72 --- -# cardx cardx website +# cardx cardx website [![R-CMD-check](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml) [![Codecov test @@ -74,7 +74,7 @@ To accomplish this we include model construction helpers. ```{r} construct_model( - x = cards::ADSL, + data = cards::ADSL, formula = reformulate2("ARM", response = "AGE"), method = "lm" ) |> diff --git a/README.md b/README.md index 7c108b27a..1e212974c 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -# cardx cardx website +# cardx cardx website [![R-CMD-check](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/insightsengineering/cardx/actions/workflows/R-CMD-check.yaml) [![Codecov test @@ -95,7 +95,7 @@ this we include model construction helpers. ``` r construct_model( - x = cards::ADSL, + data = cards::ADSL, formula = reformulate2("ARM", response = "AGE"), method = "lm" ) |> diff --git a/_pkgdown.yml b/_pkgdown.yml index a1acfa498..7300e8505 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -34,7 +34,9 @@ reference: - ard_stats_oneway_test - ard_stats_prop_test - ard_stats_t_test + - ard_stats_t_test_onesample - ard_stats_wilcox_test + - ard_stats_wilcox_test_onesample - subtitle: "{aod} package" - contents: @@ -60,14 +62,16 @@ reference: - subtitle: "{survey} package" - contents: + - ard_continuous.survey.design + - ard_attributes.survey.design - ard_survey_svychisq - - ard_survey_svycontinuous - ard_survey_svyranktest - ard_survey_svyttest - subtitle: "{survival} package" - contents: - ard_survival_survfit + - ard_survival_survfit_diff - ard_survival_survdiff - subtitle: "Other ARD functions" diff --git a/inst/WORDLIST b/inst/WORDLIST index f35e0a160..5d725809a 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -34,6 +34,7 @@ mmrm pearson pre quosures +rlang's sd strat vif diff --git a/man/ard_attributes.Rd b/man/ard_attributes.Rd new file mode 100644 index 000000000..6069aae4d --- /dev/null +++ b/man/ard_attributes.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_attributes.survey.design.R +\name{ard_attributes.survey.design} +\alias{ard_attributes.survey.design} +\title{ARD Attributes} +\usage{ +\method{ard_attributes}{survey.design}(data, variables = everything(), label = NULL, ...) +} +\arguments{ +\item{data}{(\code{survey.design})\cr +a design object often created with \code{\link[survey:svydesign]{survey::svydesign()}}.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +variables to include} + +\item{label}{(named \code{list})\cr +named list of variable labels, e.g. \code{list(cyl = "No. Cylinders")}. +Default is \code{NULL}} + +\item{...}{These dots are for future extensions and must be empty.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Add variable attributes to an ARD data frame. +\itemize{ +\item The \code{label} attribute will be added for all columns, and when no label +is specified and no label has been set for a column using the \verb{label=} argument, +the column name will be placed in the label statistic. +\item The \code{class} attribute will also be returned for all columns. +\item Any other attribute returned by \code{attributes()} will also be added, e.g. factor levels. +} +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "survey", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +data(api, package = "survey") +dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) + +ard_attributes( + data = dclus1, + variables = c(sname, dname), + label = list(sname = "School Name", dname = "District Name") +) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_survey_svycontinuous.Rd b/man/ard_continuous.survey.design.Rd similarity index 88% rename from man/ard_survey_svycontinuous.Rd rename to man/ard_continuous.survey.design.Rd index 8e5df93d2..6ba18722a 100644 --- a/man/ard_survey_svycontinuous.Rd +++ b/man/ard_continuous.survey.design.Rd @@ -1,16 +1,17 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_survey_svycontinuous.R -\name{ard_survey_svycontinuous} -\alias{ard_survey_svycontinuous} +% Please edit documentation in R/ard_continuous.survey.design.R +\name{ard_continuous.survey.design} +\alias{ard_continuous.survey.design} \title{ARD Continuous Survey Statistics} \usage{ -ard_survey_svycontinuous( +\method{ard_continuous}{survey.design}( data, variables, by = NULL, statistic = everything() ~ c("median", "p25", "p75"), fmt_fn = NULL, - stat_label = NULL + stat_label = NULL, + ... ) } \arguments{ @@ -40,6 +41,8 @@ a named list, a list of formulas, or a single formula where the list element is either a named list or a list of formulas defining the statistic labels, e.g. \code{everything() ~ list(mean = "Mean", sd = "SD")} or \code{everything() ~ list(mean ~ "Mean", sd ~ "SD")}.} + +\item{...}{These dots are for future extensions and must be empty.} } \value{ an ARD data frame of class 'card' @@ -60,7 +63,7 @@ where 'p##' is are the percentiles and \verb{##} is an integer between 0 and 100 data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) -ard_survey_svycontinuous( +ard_continuous( data = dclus1, variables = api00, by = stype diff --git a/man/ard_emmeans_mean_difference.Rd b/man/ard_emmeans_mean_difference.Rd index 97466d7d6..57a13bbcc 100644 --- a/man/ard_emmeans_mean_difference.Rd +++ b/man/ard_emmeans_mean_difference.Rd @@ -23,12 +23,17 @@ a data frame or survey design object} a formula} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function naming the function to be called, e.g. \code{"glm"}. If function belongs to a library that is not attached, the package name must be specified in the \code{package} argument.} \item{method.args}{(named \code{list})\cr -named list of arguments that will be passed to \code{fn}.} +named list of arguments that will be passed to \code{method}. + +Note that this list may contain non-standard evaluation components. +If you are wrapping this function in other functions, the argument +must be passed in a way that does not evaluate the list, e.g. +using rlang's embrace operator \code{{{ . }}}.} \item{package}{(\code{string})\cr string of package name that will be temporarily loaded when function diff --git a/man/ard_proportion_ci.Rd b/man/ard_proportion_ci.Rd index 50349110b..00c885344 100644 --- a/man/ard_proportion_ci.Rd +++ b/man/ard_proportion_ci.Rd @@ -8,12 +8,13 @@ ard_proportion_ci( data, variables, by = dplyr::group_vars(data), + method = c("waldcc", "wald", "clopper-pearson", "wilson", "wilsoncc", "strat_wilson", + "strat_wilsoncc", "agresti-coull", "jeffreys"), conf.level = 0.95, - strata, + value = list(where(is_binary) ~ 1L, where(is.logical) ~ TRUE), + strata = NULL, weights = NULL, - max.iterations = 10, - method = c("waldcc", "wald", "clopper-pearson", "wilson", "wilsoncc", "strat_wilson", - "strat_wilsoncc", "agresti-coull", "jeffreys") + max.iterations = 10 ) } \arguments{ @@ -27,17 +28,23 @@ or \verb{} values coded as \code{c(0, 1)}.} \item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr columns to stratify calculations by} +\item{method}{(\code{string})\cr +string indicating the type of confidence interval to calculate. +Must be one of 'waldcc', 'wald', 'clopper-pearson', 'wilson', 'wilsoncc', 'strat_wilson', 'strat_wilsoncc', 'agresti-coull', 'jeffreys'. +See \code{?proportion_ci} for details.} + \item{conf.level}{(\code{numeric})\cr a scalar in \verb{(0, 1)} indicating the confidence level. Default is \code{0.95}} +\item{value}{(\code{\link[=syntax]{formula-list-selector}})\cr +function will calculate the CIs for all levels of the variables specified. +Use this argument to instead request only a single level by summarized. +Default is \code{list(where(is_binary) ~ 1L, where(is.logical) ~ TRUE)}, where +columns coded as \code{0}/\code{1} and \code{TRUE}/\code{FALSE} will summarize the \code{1} and \code{TRUE} levels.} + \item{strata, weights, max.iterations}{arguments passed to \code{proportion_ci_strat_wilson()}, when \code{method='strat_wilson'}} - -\item{method}{(\code{string})\cr -string indicating the type of confidence interval to calculate. -Must be one of 'waldcc', 'wald', 'clopper-pearson', 'wilson', 'wilsoncc', 'strat_wilson', 'strat_wilsoncc', 'agresti-coull', 'jeffreys'. -See \code{?proportion_ci} for details.} } \value{ an ARD data frame @@ -48,6 +55,10 @@ Calculate confidence intervals for proportions. } \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +# compute CI for binary variables ard_proportion_ci(mtcars, variables = c(vs, am), method = "wilson") + +# compute CIs for each level of a categorical variable +ard_proportion_ci(mtcars, variables = cyl, method = "jeffreys") \dontshow{\}) # examplesIf} } diff --git a/man/ard_stats_anova.Rd b/man/ard_stats_anova.Rd index c2ec37b56..8334f72be 100644 --- a/man/ard_stats_anova.Rd +++ b/man/ard_stats_anova.Rd @@ -37,12 +37,17 @@ description.} a list of formulas} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function naming the function to be called, e.g. \code{"glm"}. If function belongs to a library that is not attached, the package name must be specified in the \code{package} argument.} \item{method.args}{(named \code{list})\cr -named list of arguments that will be passed to \code{fn}.} +named list of arguments that will be passed to \code{method}. + +Note that this list may contain non-standard evaluation components. +If you are wrapping this function in other functions, the argument +must be passed in a way that does not evaluate the list, e.g. +using rlang's embrace operator \code{{{ . }}}.} \item{package}{(\code{string})\cr string of package name that will be temporarily loaded when function diff --git a/man/ard_stats_t_test_onesample.Rd b/man/ard_stats_t_test_onesample.Rd new file mode 100644 index 000000000..26a53a373 --- /dev/null +++ b/man/ard_stats_t_test_onesample.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_t_test_onesample.R +\name{ard_stats_t_test_onesample} +\alias{ard_stats_t_test_onesample} +\title{ARD one-sample t-test} +\usage{ +ard_stats_t_test_onesample( + data, + variables, + by = dplyr::group_vars(data), + conf.level = 0.95, + ... +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +a data frame. See below for details.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be analyzed. Independent t-tests will be computed for +each variable.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +optional column name to stratify results by.} + +\item{conf.level}{(scalar \code{numeric})\cr +confidence level for confidence interval. Default is \code{0.95}.} + +\item{...}{arguments passed to \code{t.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for one-sample t-tests. +Result may be stratified by including the \code{by} argument. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +cards::ADSL |> + ard_stats_t_test_onesample(by = ARM, variables = AGE) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_stats_wilcox_test_onesample.Rd b/man/ard_stats_wilcox_test_onesample.Rd new file mode 100644 index 000000000..b01882559 --- /dev/null +++ b/man/ard_stats_wilcox_test_onesample.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_stats_wilcox_test_onesample.R +\name{ard_stats_wilcox_test_onesample} +\alias{ard_stats_wilcox_test_onesample} +\title{ARD one-sample Wilcox Rank-sum} +\usage{ +ard_stats_wilcox_test_onesample( + data, + variables, + by = dplyr::group_vars(data), + conf.level = 0.95, + ... +) +} +\arguments{ +\item{data}{(\code{data.frame})\cr +a data frame. See below for details.} + +\item{variables}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column names to be analyzed. Independent Wilcox Rank-sum tests will be computed for +each variable.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +optional column name to stratify results by.} + +\item{conf.level}{(scalar \code{numeric})\cr +confidence level for confidence interval. Default is \code{0.95}.} + +\item{...}{arguments passed to \code{wilcox.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for one-sample Wilcox Rank-sum. +Result may be stratified by including the \code{by} argument. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +cards::ADSL |> + ard_stats_wilcox_test_onesample(by = ARM, variables = AGE) +\dontshow{\}) # examplesIf} +} diff --git a/man/ard_survival_survfit_diff.Rd b/man/ard_survival_survfit_diff.Rd new file mode 100644 index 000000000..3a7a7bd7d --- /dev/null +++ b/man/ard_survival_survfit_diff.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survival_survfit_diff.R +\name{ard_survival_survfit_diff} +\alias{ard_survival_survfit_diff} +\title{ARD Survival Differences} +\usage{ +ard_survival_survfit_diff(x, times, conf.level = 0.95) +} +\arguments{ +\item{x}{(\code{survift})\cr +object of class \code{'survfit'} typically created with \code{\link[survival:survfit]{survival::survfit()}}} + +\item{times}{(\code{numeric})\cr +a vector of times for which to return survival probabilities.} + +\item{conf.level}{(scalar \code{numeric})\cr +confidence level for confidence interval. Default is \code{0.95}.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Calculate differences in the Kaplan-Meier estimator of survival using the +results from \code{\link[survival:survfit]{survival::survfit()}}. +} +\examples{ +\dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("survival", "ggsurvfit"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(ggsurvfit) +library(survival) + +survfit(Surv_CNSR() ~ TRTA, data = cards::ADTTE) |> + ard_survival_survfit_diff(times = c(25, 50)) +\dontshow{\}) # examplesIf} +} diff --git a/man/construction_helpers.Rd b/man/construction_helpers.Rd index 9e4793c38..4cfcc9056 100644 --- a/man/construction_helpers.Rd +++ b/man/construction_helpers.Rd @@ -10,10 +10,10 @@ \alias{bt_strip} \title{Construction Helpers} \usage{ -construct_model(x, ...) +construct_model(data, ...) \method{construct_model}{data.frame}( - x, + data, formula, method, method.args = list(), @@ -23,7 +23,7 @@ construct_model(x, ...) ) \method{construct_model}{survey.design}( - x, + data, formula, method, method.args = list(), @@ -46,10 +46,9 @@ bt(x, pattern = "[ \\n\\r]") bt_strip(x) } \arguments{ -\item{x}{\itemize{ +\item{data}{\itemize{ \item \code{construct_model.data.frame()} (\code{data.frame}) a data frame \item \code{construct_model.survey.design()} (\code{survey.design}) a survey design object -\item \code{bt()}/\code{bt_strip()} (\code{character}) character vector, typically of variable names }} \item{...}{These dots are for future extensions and must be empty.} @@ -58,12 +57,17 @@ bt_strip(x) a formula} \item{method}{(\code{string})\cr -string naming the function to be called, e.g. \code{"glm"}. +string of function naming the function to be called, e.g. \code{"glm"}. If function belongs to a library that is not attached, the package name must be specified in the \code{package} argument.} \item{method.args}{(named \code{list})\cr -named list of arguments that will be passed to \code{fn}.} +named list of arguments that will be passed to \code{method}. + +Note that this list may contain non-standard evaluation components. +If you are wrapping this function in other functions, the argument +must be passed in a way that does not evaluate the list, e.g. +using rlang's embrace operator \code{{{ . }}}.} \item{package}{(\code{string})\cr string of package name that will be temporarily loaded when function @@ -84,6 +88,9 @@ their own environments.} \item{pattern_term, pattern_response}{passed to \code{bt(pattern)} for arguments \code{stats::reformulate(termlabels, response)}.} +\item{x}{(\code{character})\cr +character vector, typically of variable names} + \item{pattern}{(\code{string})\cr regular expression string. If the regex matches, backticks are added to the string. When \code{NULL}, backticks are not added.} @@ -108,7 +115,7 @@ names that contain a space are wrapped in backticks. \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = c("withr", "lme4", "broom.helpers", "broom.mixed"), reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} construct_model( - x = mtcars, + data = mtcars, formula = am ~ mpg + (1 | vs), method = "glmer", method.args = list(family = binomial), @@ -117,7 +124,7 @@ construct_model( broom.mixed::tidy() construct_model( - x = mtcars |> dplyr::rename(`M P G` = mpg), + data = mtcars |> dplyr::rename(`M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm" ) |> diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index c6f9bee25..cc3b6682c 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -4,7 +4,7 @@ \alias{.process_survfit_time} \title{Process Survival Fit For Time Estimates} \usage{ -.process_survfit_time(x, times, type) +.process_survfit_time(x, times, type, start.time = NULL) } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr @@ -22,6 +22,9 @@ Must be one of the following:\tabular{ll}{ \code{"risk"} \tab \code{1 - x} \cr \code{"cumhaz"} \tab \code{-log(x)} \cr }} + +\item{start.time}{(\code{numeric})\cr +default starting time. See \code{\link[survival:survfit0]{survival::survfit0()}} for more details.} } \value{ a \code{tibble} diff --git a/man/figures/lifecycle-archived.svg b/man/figures/lifecycle-archived.svg new file mode 100644 index 000000000..745ab0c78 --- /dev/null +++ b/man/figures/lifecycle-archived.svg @@ -0,0 +1,21 @@ + + lifecycle: archived + + + + + + + + + + + + + + + lifecycle + + archived + + diff --git a/man/figures/lifecycle-defunct.svg b/man/figures/lifecycle-defunct.svg new file mode 100644 index 000000000..d5c9559ed --- /dev/null +++ b/man/figures/lifecycle-defunct.svg @@ -0,0 +1,21 @@ + + lifecycle: defunct + + + + + + + + + + + + + + + lifecycle + + defunct + + diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 000000000..b61c57c3f --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: deprecated + + + + + + + + + + + + + + + lifecycle + + deprecated + + diff --git a/man/figures/lifecycle-experimental.svg b/man/figures/lifecycle-experimental.svg new file mode 100644 index 000000000..5d88fc2c6 --- /dev/null +++ b/man/figures/lifecycle-experimental.svg @@ -0,0 +1,21 @@ + + lifecycle: experimental + + + + + + + + + + + + + + + lifecycle + + experimental + + diff --git a/man/figures/lifecycle-maturing.svg b/man/figures/lifecycle-maturing.svg new file mode 100644 index 000000000..897370ecf --- /dev/null +++ b/man/figures/lifecycle-maturing.svg @@ -0,0 +1,21 @@ + + lifecycle: maturing + + + + + + + + + + + + + + + lifecycle + + maturing + + diff --git a/man/figures/lifecycle-questioning.svg b/man/figures/lifecycle-questioning.svg new file mode 100644 index 000000000..7c1721d05 --- /dev/null +++ b/man/figures/lifecycle-questioning.svg @@ -0,0 +1,21 @@ + + lifecycle: questioning + + + + + + + + + + + + + + + lifecycle + + questioning + + diff --git a/man/figures/lifecycle-soft-deprecated.svg b/man/figures/lifecycle-soft-deprecated.svg new file mode 100644 index 000000000..9c166ff30 --- /dev/null +++ b/man/figures/lifecycle-soft-deprecated.svg @@ -0,0 +1,21 @@ + + lifecycle: soft-deprecated + + + + + + + + + + + + + + + lifecycle + + soft-deprecated + + diff --git a/man/figures/lifecycle-stable.svg b/man/figures/lifecycle-stable.svg new file mode 100644 index 000000000..9bf21e76b --- /dev/null +++ b/man/figures/lifecycle-stable.svg @@ -0,0 +1,29 @@ + + lifecycle: stable + + + + + + + + + + + + + + + + lifecycle + + + + stable + + + diff --git a/man/figures/lifecycle-superseded.svg b/man/figures/lifecycle-superseded.svg new file mode 100644 index 000000000..db8d757f7 --- /dev/null +++ b/man/figures/lifecycle-superseded.svg @@ -0,0 +1,21 @@ + + lifecycle: superseded + + + + + + + + + + + + + + + lifecycle + + superseded + + diff --git a/man/proportion_ci.Rd b/man/proportion_ci.Rd index 8094fc047..f2a5d9039 100644 --- a/man/proportion_ci.Rd +++ b/man/proportion_ci.Rd @@ -8,6 +8,7 @@ \alias{proportion_ci_agresti_coull} \alias{proportion_ci_jeffreys} \alias{proportion_ci_strat_wilson} +\alias{is_binary} \title{Functions for Calculating Proportion Confidence Intervals} \usage{ proportion_ci_wald(x, conf.level = 0.95, correct = FALSE) @@ -28,6 +29,8 @@ proportion_ci_strat_wilson( max.iterations = 10L, correct = FALSE ) + +is_binary(x) } \arguments{ \item{x}{vector of a binary values, i.e. a logical vector, or numeric with values \code{c(0, 1)}} @@ -99,6 +102,8 @@ for multiple binomial proportions. \emph{Statistics in Biopharmaceutical Researc z_{\alpha/2} \sqrt{\frac{\hat{p}_j(1 - \hat{p}_j)}{n_j} + \frac{z^2_{\alpha/2}}{4n_j^2}}}{1 + \frac{z^2_{\alpha/2}}{n_j}}} +\item \code{is_binary()}: Helper to determine if vector is binary (logical or 0/1) + }} \examples{ \dontshow{if (do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} diff --git a/man/reexports.Rd b/man/reexports.Rd index 12e1f5269..927068d41 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -3,6 +3,11 @@ \docType{import} \name{reexports} \alias{reexports} +\alias{ard_continuous} +\alias{ard_categorical} +\alias{ard_dichotomous} +\alias{ard_missing} +\alias{ard_attributes} \alias{\%>\%} \alias{starts_with} \alias{ends_with} @@ -22,6 +27,8 @@ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ + \item{cards}{\code{\link[cards]{ard_attributes}}, \code{\link[cards]{ard_categorical}}, \code{\link[cards]{ard_continuous}}, \code{\link[cards]{ard_dichotomous}}, \code{\link[cards]{ard_missing}}} + \item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}, \code{\link[dplyr:reexports]{all_of}}, \code{\link[dplyr:reexports]{any_of}}, \code{\link[dplyr:reexports]{contains}}, \code{\link[dplyr:reexports]{ends_with}}, \code{\link[dplyr:reexports]{everything}}, \code{\link[dplyr:reexports]{last_col}}, \code{\link[dplyr:reexports]{matches}}, \code{\link[dplyr:reexports]{num_range}}, \code{\link[dplyr:reexports]{one_of}}, \code{\link[dplyr:reexports]{starts_with}}, \code{\link[dplyr:reexports]{where}}} }} diff --git a/tests/testthat/_snaps/ard_attributes.survey.design.md b/tests/testthat/_snaps/ard_attributes.survey.design.md new file mode 100644 index 000000000..6c373f28f --- /dev/null +++ b/tests/testthat/_snaps/ard_attributes.survey.design.md @@ -0,0 +1,13 @@ +# ard_attributes.survey.design() works + + Code + attr(dclus1$variables$sname, "label") <- "School Name" + as.data.frame(ard_attributes(dclus1, variables = c(sname, dname), label = list( + dname = "District Name"))) + Output + variable context stat_name stat_label stat + 1 sname attributes label Variable Label School Name + 2 sname attributes class Variable Class character + 3 dname attributes label Variable Label District Name + 4 dname attributes class Variable Class character + diff --git a/tests/testthat/_snaps/ard_survey_svycontinuous.md b/tests/testthat/_snaps/ard_continuous.survey.design.md similarity index 77% rename from tests/testthat/_snaps/ard_survey_svycontinuous.md rename to tests/testthat/_snaps/ard_continuous.survey.design.md index 7dbd96603..348621925 100644 --- a/tests/testthat/_snaps/ard_survey_svycontinuous.md +++ b/tests/testthat/_snaps/ard_continuous.survey.design.md @@ -1,4 +1,4 @@ -# unstratified ard_survey_svycontinuous() works +# unstratified ard_continuous.survey.design() works Code ard_uni_svy_cont @@ -19,12 +19,11 @@ Message i 2 more variables: warning, error -# ard_survey_svycontinuous(fmt_fn) +# ard_continuous.survey.design(fmt_fn) Code - ard_survey_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", - "median", "min", "max"), fmt_fn = list(api00 = list(mean = 2, median = "xx.xx", - min = as.character))) + ard_continuous(dclus1, variables = api00, statistic = ~ c("mean", "median", + "min", "max"), fmt_fn = list(api00 = list(mean = 2, median = "xx.xx", min = as.character))) Message {cards} data frame: 4 x 8 Output @@ -36,12 +35,12 @@ Message i 2 more variables: warning, error -# ard_survey_svycontinuous(stat_label) +# ard_continuous.survey.design(stat_label) Code - ard_survey_svycontinuous(dclus1, variables = api00, statistic = ~ c("mean", - "median", "min", "max"), stat_label = list(api00 = list(mean = "MeAn", - median = "MEDian", min = "MINimum"))) + ard_continuous(dclus1, variables = api00, statistic = ~ c("mean", "median", + "min", "max"), stat_label = list(api00 = list(mean = "MeAn", median = "MEDian", + min = "MINimum"))) Message {cards} data frame: 4 x 8 Output diff --git a/tests/testthat/_snaps/ard_proportion_ci.md b/tests/testthat/_snaps/ard_proportion_ci.md index d7388ed0f..94a7c043f 100644 --- a/tests/testthat/_snaps/ard_proportion_ci.md +++ b/tests/testthat/_snaps/ard_proportion_ci.md @@ -3,32 +3,43 @@ Code ard_proportion_ci_strat_wilson Message - {cards} data frame: 6 x 8 + {cards} data frame: 6 x 9 Output - variable context stat_name stat_label stat fmt_fn - 1 rsp proporti… N N 80 0 - 2 rsp proporti… estimate estimate 0.625 1 - 3 rsp proporti… conf.low conf.low 0.487 1 - 4 rsp proporti… conf.high conf.high 0.719 1 - 5 rsp proporti… conf.level conf.lev… 0.95 1 - 6 rsp proporti… method method Stratifi… + variable variable_level context stat_name stat_label stat + 1 rsp TRUE proporti… N N 80 + 2 rsp TRUE proporti… estimate estimate 0.625 + 3 rsp TRUE proporti… conf.low conf.low 0.487 + 4 rsp TRUE proporti… conf.high conf.high 0.719 + 5 rsp TRUE proporti… conf.level conf.lev… 0.95 + 6 rsp TRUE proporti… method method Stratifi… Message - i 2 more variables: warning, error + i 3 more variables: fmt_fn, warning, error --- Code ard_proportion_ci_strat_wilsoncc Message - {cards} data frame: 6 x 8 + {cards} data frame: 6 x 9 Output - variable context stat_name stat_label stat fmt_fn - 1 rsp proporti… N N 80 0 - 2 rsp proporti… estimate estimate 0.625 1 - 3 rsp proporti… conf.low conf.low 0.448 1 - 4 rsp proporti… conf.high conf.high 0.753 1 - 5 rsp proporti… conf.level conf.lev… 0.95 1 - 6 rsp proporti… method method Stratifi… + variable variable_level context stat_name stat_label stat + 1 rsp TRUE proporti… N N 80 + 2 rsp TRUE proporti… estimate estimate 0.625 + 3 rsp TRUE proporti… conf.low conf.low 0.448 + 4 rsp TRUE proporti… conf.high conf.high 0.753 + 5 rsp TRUE proporti… conf.level conf.lev… 0.95 + 6 rsp TRUE proporti… method method Stratifi… Message - i 2 more variables: warning, error + i 3 more variables: fmt_fn, warning, error + +# ard_proportion_ci() messaging + + Code + ard <- ard_proportion_ci(data = mtcars, variables = cyl, value = cyl ~ 10, + method = "jeffreys") + Condition + Warning: + A value of `value=10` for variable "cyl" was passed, but is not one of the observed levels: 4, 6, and 8. + i This may be an error. + i If value is a valid, convert variable to factor with all levels specified to avoid this message. diff --git a/tests/testthat/_snaps/ard_survival_survfit.md b/tests/testthat/_snaps/ard_survival_survfit.md index 6697507dd..7f2a2529d 100644 --- a/tests/testthat/_snaps/ard_survival_survfit.md +++ b/tests/testthat/_snaps/ard_survival_survfit.md @@ -5,27 +5,39 @@ CNSR) ~ TRTA, cards::ADTTE), times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 18 x 11 + {cards} data frame: 30 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat - 1 TRTA Placebo time 60 estimate Survival… 0.893 - 2 TRTA Placebo time 60 conf.high CI Upper… 0.966 - 3 TRTA Placebo time 60 conf.low CI Lower… 0.825 - 4 TRTA Placebo time 180 estimate Survival… 0.651 - 5 TRTA Placebo time 180 conf.high CI Upper… 0.783 - 6 TRTA Placebo time 180 conf.low CI Lower… 0.541 - 7 TRTA Xanomeli… time 60 estimate Survival… 0.694 - 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.849 - 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.568 - 10 TRTA Xanomeli… time 180 estimate Survival… 0.262 - 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.749 - 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.092 - 13 TRTA Xanomeli… time 60 estimate Survival… 0.732 - 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.878 - 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.61 - 16 TRTA Xanomeli… time 180 estimate Survival… 0.381 - 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.743 - 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.195 + 1 TRTA Placebo time 60 n.risk Number o… 59 + 2 TRTA Placebo time 60 estimate Survival… 0.893 + 3 TRTA Placebo time 60 std.error Standard… 0.036 + 4 TRTA Placebo time 60 conf.high CI Upper… 0.966 + 5 TRTA Placebo time 60 conf.low CI Lower… 0.825 + 6 TRTA Placebo time 180 n.risk Number o… 35 + 7 TRTA Placebo time 180 estimate Survival… 0.651 + 8 TRTA Placebo time 180 std.error Standard… 0.061 + 9 TRTA Placebo time 180 conf.high CI Upper… 0.783 + 10 TRTA Placebo time 180 conf.low CI Lower… 0.541 + 11 TRTA Xanomeli… time 60 n.risk Number o… 14 + 12 TRTA Xanomeli… time 60 estimate Survival… 0.694 + 13 TRTA Xanomeli… time 60 std.error Standard… 0.071 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.849 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.568 + 16 TRTA Xanomeli… time 180 n.risk Number o… 3 + 17 TRTA Xanomeli… time 180 estimate Survival… 0.262 + 18 TRTA Xanomeli… time 180 std.error Standard… 0.14 + 19 TRTA Xanomeli… time 180 conf.high CI Upper… 0.749 + 20 TRTA Xanomeli… time 180 conf.low CI Lower… 0.092 + 21 TRTA Xanomeli… time 60 n.risk Number o… 20 + 22 TRTA Xanomeli… time 60 estimate Survival… 0.732 + 23 TRTA Xanomeli… time 60 std.error Standard… 0.068 + 24 TRTA Xanomeli… time 60 conf.high CI Upper… 0.878 + 25 TRTA Xanomeli… time 60 conf.low CI Lower… 0.61 + 26 TRTA Xanomeli… time 180 n.risk Number o… 5 + 27 TRTA Xanomeli… time 180 estimate Survival… 0.381 + 28 TRTA Xanomeli… time 180 std.error Standard… 0.13 + 29 TRTA Xanomeli… time 180 conf.high CI Upper… 0.743 + 30 TRTA Xanomeli… time 180 conf.low CI Lower… 0.195 Message i 4 more variables: context, fmt_fn, warning, error @@ -36,27 +48,39 @@ CNSR) ~ TRTA, cards::ADTTE), times = c(60, 180), type = "risk"), stat = lapply( stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 18 x 11 + {cards} data frame: 30 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat - 1 TRTA Placebo time 60 estimate Survival… 0.107 - 2 TRTA Placebo time 60 conf.high CI Upper… 0.175 - 3 TRTA Placebo time 60 conf.low CI Lower… 0.034 - 4 TRTA Placebo time 180 estimate Survival… 0.349 - 5 TRTA Placebo time 180 conf.high CI Upper… 0.459 - 6 TRTA Placebo time 180 conf.low CI Lower… 0.217 - 7 TRTA Xanomeli… time 60 estimate Survival… 0.306 - 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.432 - 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.151 - 10 TRTA Xanomeli… time 180 estimate Survival… 0.738 - 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.908 - 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.251 - 13 TRTA Xanomeli… time 60 estimate Survival… 0.268 - 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.39 - 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.122 - 16 TRTA Xanomeli… time 180 estimate Survival… 0.619 - 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.805 - 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.257 + 1 TRTA Placebo time 60 n.risk Number o… 59 + 2 TRTA Placebo time 60 estimate Survival… 0.107 + 3 TRTA Placebo time 60 std.error Standard… 0.036 + 4 TRTA Placebo time 60 conf.high CI Upper… 0.175 + 5 TRTA Placebo time 60 conf.low CI Lower… 0.034 + 6 TRTA Placebo time 180 n.risk Number o… 35 + 7 TRTA Placebo time 180 estimate Survival… 0.349 + 8 TRTA Placebo time 180 std.error Standard… 0.061 + 9 TRTA Placebo time 180 conf.high CI Upper… 0.459 + 10 TRTA Placebo time 180 conf.low CI Lower… 0.217 + 11 TRTA Xanomeli… time 60 n.risk Number o… 14 + 12 TRTA Xanomeli… time 60 estimate Survival… 0.306 + 13 TRTA Xanomeli… time 60 std.error Standard… 0.071 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.432 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.151 + 16 TRTA Xanomeli… time 180 n.risk Number o… 3 + 17 TRTA Xanomeli… time 180 estimate Survival… 0.738 + 18 TRTA Xanomeli… time 180 std.error Standard… 0.14 + 19 TRTA Xanomeli… time 180 conf.high CI Upper… 0.908 + 20 TRTA Xanomeli… time 180 conf.low CI Lower… 0.251 + 21 TRTA Xanomeli… time 60 n.risk Number o… 20 + 22 TRTA Xanomeli… time 60 estimate Survival… 0.268 + 23 TRTA Xanomeli… time 60 std.error Standard… 0.068 + 24 TRTA Xanomeli… time 60 conf.high CI Upper… 0.39 + 25 TRTA Xanomeli… time 60 conf.low CI Lower… 0.122 + 26 TRTA Xanomeli… time 180 n.risk Number o… 5 + 27 TRTA Xanomeli… time 180 estimate Survival… 0.619 + 28 TRTA Xanomeli… time 180 std.error Standard… 0.13 + 29 TRTA Xanomeli… time 180 conf.high CI Upper… 0.805 + 30 TRTA Xanomeli… time 180 conf.low CI Lower… 0.257 Message i 4 more variables: context, fmt_fn, warning, error @@ -98,15 +122,19 @@ status) ~ 1, data = survival::lung), times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 6 x 9 + {cards} data frame: 10 x 9 Output - variable variable_level context stat_name stat_label stat - 1 time 60 survival estimate Survival… 0.925 - 2 time 60 survival conf.high CI Upper… 0.96 - 3 time 60 survival conf.low CI Lower… 0.892 - 4 time 180 survival estimate Survival… 0.722 - 5 time 180 survival conf.high CI Upper… 0.783 - 6 time 180 survival conf.low CI Lower… 0.666 + variable variable_level context stat_name stat_label stat + 1 time 60 survival n.risk Number o… 213 + 2 time 60 survival estimate Survival… 0.925 + 3 time 60 survival std.error Standard… 0.017 + 4 time 60 survival conf.high CI Upper… 0.96 + 5 time 60 survival conf.low CI Lower… 0.892 + 6 time 180 survival n.risk Number o… 160 + 7 time 180 survival estimate Survival… 0.722 + 8 time 180 survival std.error Standard… 0.03 + 9 time 180 survival conf.high CI Upper… 0.783 + 10 time 180 survival conf.low CI Lower… 0.666 Message i 3 more variables: fmt_fn, warning, error @@ -146,20 +174,20 @@ 4 sex 1 ph.ecog 0 5 sex 1 ph.ecog 0 6 sex 1 ph.ecog 0 - 7 sex 1 ph.ecog 1 - 8 sex 1 ph.ecog 1 - 9 sex 1 ph.ecog 1 - 10 sex 1 ph.ecog 1 + 7 sex 1 ph.ecog 0 + 8 sex 1 ph.ecog 0 + 9 sex 1 ph.ecog 0 + 10 sex 1 ph.ecog 0 11 sex 1 ph.ecog 1 12 sex 1 ph.ecog 1 - 13 sex 1 ph.ecog 2 - 14 sex 1 ph.ecog 2 - 15 sex 1 ph.ecog 2 - 16 sex 1 ph.ecog 2 - 17 sex 1 ph.ecog 2 - 18 sex 1 ph.ecog 2 - 19 sex 1 ph.ecog 3 - 20 sex 1 ph.ecog 3 + 13 sex 1 ph.ecog 1 + 14 sex 1 ph.ecog 1 + 15 sex 1 ph.ecog 1 + 16 sex 1 ph.ecog 1 + 17 sex 1 ph.ecog 1 + 18 sex 1 ph.ecog 1 + 19 sex 1 ph.ecog 1 + 20 sex 1 ph.ecog 1 --- @@ -201,27 +229,39 @@ ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message Multi-state model detected. Showing probabilities into state 'death from cancer'. - {cards} data frame: 18 x 11 + {cards} data frame: 30 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat - 1 TRTA Placebo time 60 estimate Survival… 0.054 - 2 TRTA Placebo time 60 conf.high CI Upper… 0.14 - 3 TRTA Placebo time 60 conf.low CI Lower… 0.021 - 4 TRTA Placebo time 180 estimate Survival… 0.226 - 5 TRTA Placebo time 180 conf.high CI Upper… 0.361 - 6 TRTA Placebo time 180 conf.low CI Lower… 0.142 - 7 TRTA Xanomeli… time 60 estimate Survival… 0.137 - 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.311 - 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.06 - 10 TRTA Xanomeli… time 180 estimate Survival… 0.51 - 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.892 - 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.292 - 13 TRTA Xanomeli… time 60 estimate Survival… 0.162 - 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.33 - 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.08 - 16 TRTA Xanomeli… time 180 estimate Survival… 0.244 - 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.516 - 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.115 + 1 TRTA Placebo time 60 n.risk Number o… 59 + 2 TRTA Placebo time 60 estimate Survival… 0.054 + 3 TRTA Placebo time 60 std.error Standard… 0.026 + 4 TRTA Placebo time 60 conf.high CI Upper… 0.14 + 5 TRTA Placebo time 60 conf.low CI Lower… 0.021 + 6 TRTA Placebo time 180 n.risk Number o… 35 + 7 TRTA Placebo time 180 estimate Survival… 0.226 + 8 TRTA Placebo time 180 std.error Standard… 0.054 + 9 TRTA Placebo time 180 conf.high CI Upper… 0.361 + 10 TRTA Placebo time 180 conf.low CI Lower… 0.142 + 11 TRTA Xanomeli… time 60 n.risk Number o… 14 + 12 TRTA Xanomeli… time 60 estimate Survival… 0.137 + 13 TRTA Xanomeli… time 60 std.error Standard… 0.057 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.311 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.06 + 16 TRTA Xanomeli… time 180 n.risk Number o… 3 + 17 TRTA Xanomeli… time 180 estimate Survival… 0.51 + 18 TRTA Xanomeli… time 180 std.error Standard… 0.145 + 19 TRTA Xanomeli… time 180 conf.high CI Upper… 0.892 + 20 TRTA Xanomeli… time 180 conf.low CI Lower… 0.292 + 21 TRTA Xanomeli… time 60 n.risk Number o… 20 + 22 TRTA Xanomeli… time 60 estimate Survival… 0.162 + 23 TRTA Xanomeli… time 60 std.error Standard… 0.059 + 24 TRTA Xanomeli… time 60 conf.high CI Upper… 0.33 + 25 TRTA Xanomeli… time 60 conf.low CI Lower… 0.08 + 26 TRTA Xanomeli… time 180 n.risk Number o… 5 + 27 TRTA Xanomeli… time 180 estimate Survival… 0.244 + 28 TRTA Xanomeli… time 180 std.error Standard… 0.093 + 29 TRTA Xanomeli… time 180 conf.high CI Upper… 0.516 + 30 TRTA Xanomeli… time 180 conf.low CI Lower… 0.115 Message i 4 more variables: context, fmt_fn, warning, error diff --git a/tests/testthat/_snaps/ard_survival_survfit_diff.md b/tests/testthat/_snaps/ard_survival_survfit_diff.md new file mode 100644 index 000000000..c5ffc0c7c --- /dev/null +++ b/tests/testthat/_snaps/ard_survival_survfit_diff.md @@ -0,0 +1,27 @@ +# ard_survival_survfit_diff() messaging + + Code + ard_survival_survfit_diff(survfit(Surv(AVAL, 1 - CNSR) ~ SEX + TRTA, cards::ADTTE), + times = c(25, 50)) + Condition + Error in `ard_survival_survfit_diff()`: + ! The object passed in argument `x` must be stratified by a single variable. + +--- + + Code + ard_survival_survfit_diff(survfit(Surv(AVAL, 1 - CNSR) ~ constant, dplyr::mutate( + cards::ADTTE, constant = 1L)), times = c(25, 50)) + Condition + Error in `ard_survival_survfit_diff()`: + ! The object's stratifying variable must have 2 or more levels. + +--- + + Code + ard_survival_survfit_diff(survfit(coxph(Surv(AVAL, CNSR) ~ SEX + strata(TRTA), + cards::ADTTE)), times = c(25, 50)) + Condition + Error in `ard_survival_survfit_diff()`: + ! Argument `x` cannot be class . + diff --git a/tests/testthat/_snaps/construction_helpers.md b/tests/testthat/_snaps/construction_helpers.md index d904c5939..5f6e77afd 100644 --- a/tests/testthat/_snaps/construction_helpers.md +++ b/tests/testthat/_snaps/construction_helpers.md @@ -1,7 +1,7 @@ # construct_model() works Code - dplyr::filter(as.data.frame(ard_regression(construct_model(x = dplyr::rename( + dplyr::filter(as.data.frame(ard_regression(construct_model(data = dplyr::rename( mtcars, `M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm"))), stat_name %in% c("term", "estimate", "p.value")) Output @@ -13,3 +13,20 @@ 5 cyl regression estimate Coefficient 23.97863 1 6 cyl regression p.value p-value 0.002814958 1 +# construct_model() messaging + + Code + construct_model(data = mtcars, method = "survival::coxph", formula = survival::Surv( + mpg, am) ~ cyl) + Condition + Error in `construct_model()`: + ! Argument `method` cannot be namespaced when passed as a . + +--- + + Code + construct_model(data = mtcars, method = letters, formula = am ~ cyl) + Condition + Error in `construct_model()`: + ! Argument `method` must be a or . + diff --git a/tests/testthat/test-ard_attributes.survey.design.R b/tests/testthat/test-ard_attributes.survey.design.R new file mode 100644 index 000000000..e4f663eec --- /dev/null +++ b/tests/testthat/test-ard_attributes.survey.design.R @@ -0,0 +1,17 @@ +skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) + +test_that("ard_attributes.survey.design() works", { + data(api, package = "survey") + dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) + + expect_snapshot({ + attr(dclus1$variables$sname, "label") <- "School Name" + + ard_attributes( + dclus1, + variables = c(sname, dname), + label = list(dname = "District Name") + ) |> + as.data.frame() + }) +}) diff --git a/tests/testthat/test-ard_survey_svycontinuous.R b/tests/testthat/test-ard_continuous.survey.design.R similarity index 93% rename from tests/testthat/test-ard_survey_svycontinuous.R rename to tests/testthat/test-ard_continuous.survey.design.R index 85e737ce7..5b999d918 100644 --- a/tests/testthat/test-ard_survey_svycontinuous.R +++ b/tests/testthat/test-ard_continuous.survey.design.R @@ -1,12 +1,12 @@ skip_if_not(is_pkg_installed("survey", reference_pkg = "cardx")) -test_that("unstratified ard_survey_svycontinuous() works", { +test_that("unstratified ard_continuous.survey.design() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_uni_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c( @@ -71,13 +71,13 @@ test_that("unstratified ard_survey_svycontinuous() works", { }) -test_that("stratified ard_survey_svycontinuous() works", { +test_that("stratified ard_continuous.survey.design() works", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_error( ard_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, by = both, variables = api00, @@ -238,13 +238,13 @@ test_that("stratified ard_survey_svycontinuous() works", { ) }) -test_that("ard_survey_svycontinuous() NA handling", { +test_that("ard_continuous.survey.design() NA handling", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1 |> dplyr::mutate(api00 = NA_real_), fpc = ~fpc) expect_error( ard_uni_NA_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c( @@ -263,7 +263,7 @@ test_that("ard_survey_svycontinuous() NA handling", { expect_error( ard_NA_svy_cont <- - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = both, @@ -282,7 +282,7 @@ test_that("ard_survey_svycontinuous() NA handling", { ) }) -test_that("ard_survey_svycontinuous() error handling", { +test_that("ard_continuous.survey.design() error handling", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1[1:20, ], fpc = ~fpc) @@ -290,7 +290,7 @@ test_that("ard_survey_svycontinuous() error handling", { # and these "results" may vary across systems (all are nonsense), so just check # that code runs without error expect_error( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = sname, statistic = ~ c( @@ -302,7 +302,7 @@ test_that("ard_survey_svycontinuous() error handling", { ) expect_error( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = sname, by = both, @@ -315,12 +315,12 @@ test_that("ard_survey_svycontinuous() error handling", { ) }) -test_that("ard_survey_svycontinuous(fmt_fn)", { +test_that("ard_continuous.survey.design(fmt_fn)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -329,12 +329,12 @@ test_that("ard_survey_svycontinuous(fmt_fn)", { ) }) -test_that("ard_survey_svycontinuous(stat_label)", { +test_that("ard_continuous.survey.design(stat_label)", { data(api, package = "survey") dclus1 <- survey::svydesign(id = ~dnum, weights = ~pw, data = apiclus1, fpc = ~fpc) expect_snapshot( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, statistic = ~ c("mean", "median", "min", "max"), @@ -343,7 +343,7 @@ test_that("ard_survey_svycontinuous(stat_label)", { ) }) -test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { +test_that("ard_continuous.survey.design(by) unobserved levels/combinations", { data(api, package = "survey") dclus1 <- survey::svydesign( id = ~dnum, weights = ~pw, @@ -359,7 +359,7 @@ test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { # The 'Neither' level is never observed, but included in the table expect_setequal( levels(dclus1$variables$both), - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = both, @@ -373,7 +373,7 @@ test_that("ard_survey_svycontinuous(by) unobserved levels/combinations", { # stype="E" is not observed with awards="No", but it should still appear in table with(dclus1$variables, table(stype, awards)) expect_equal( - ard_survey_svycontinuous( + ard_continuous( dclus1, variables = api00, by = c(stype, awards), diff --git a/tests/testthat/test-ard_proportion_ci.R b/tests/testthat/test-ard_proportion_ci.R index 6f7ceb9b7..03e9bcc87 100644 --- a/tests/testthat/test-ard_proportion_ci.R +++ b/tests/testthat/test-ard_proportion_ci.R @@ -1,12 +1,13 @@ skip_if_not(do.call(asNamespace("cardx")$is_pkg_installed, list(pkg = "broom", reference_pkg = "cardx"))) test_that("ard_proportion_ci() works", { - # testing the easy methods together + # testing the easy methods together for binary variables expect_error( - c( - "waldcc", "wald", "clopper-pearson", - "wilson", "wilsoncc", "agresti-coull", "jeffreys" - ) |> + lst_ard_props <- + c( + "waldcc", "wald", "clopper-pearson", + "wilson", "wilsoncc", "agresti-coull", "jeffreys" + ) |> lapply( \(x) { ard_proportion_ci( @@ -18,6 +19,44 @@ test_that("ard_proportion_ci() works", { ), NA ) + expect_equal( + lst_ard_props[[1]] |> + cards::get_ard_statistics( + stat_name %in% c("estimate", "conf.low", "conf.high"), + variable == "am" + ), + proportion_ci_wald(mtcars$am, correct = TRUE)[c("estimate", "conf.low", "conf.high")] + ) + + # testing a categorical variable + expect_error( + ard_factor <- + ard_proportion_ci( + mtcars |> dplyr::mutate(cyl = factor(cyl, levels = c(4, 6, 8, 10))), + variables = cyl, + by = am + ), + NA + ) + expect_equal( + cards::get_ard_statistics( + ard_factor, + group1_level %in% 0, + map_lgl(variable_level, ~ .x == "4") + )[c("estimate", "conf.low", "conf.high")], + proportion_ci_wald(mtcars$cyl[mtcars$am == 0] == 4, correct = TRUE)[c("estimate", "conf.low", "conf.high")] + ) + # now checking the unobserved level of cyl + expect_equal( + cards::get_ard_statistics( + ard_factor, + group1_level %in% 0, + unlist(variable_level) == "10" + )[c("estimate", "conf.low", "conf.high")], + proportion_ci_wald(mtcars$cyl[mtcars$am == 0] == 10, correct = TRUE)[c("estimate", "conf.low", "conf.high")] + ) + # checking structure + expect_silent(cards::check_ard_structure(ard_factor)) }) test_that("ard_proportion_ci(method='strat_wilson') works", { @@ -45,6 +84,7 @@ test_that("ard_proportion_ci(method='strat_wilson') works", { variables = rsp, strata = strata, weights = weights, + max.iterations = 10, method = "strat_wilson" ), NA @@ -61,9 +101,21 @@ test_that("ard_proportion_ci(method='strat_wilson') works", { variables = rsp, strata = strata, weights = weights, + max.iterations = 10, method = "strat_wilsoncc" ), NA ) expect_snapshot(ard_proportion_ci_strat_wilsoncc) }) + +test_that("ard_proportion_ci() messaging", { + expect_snapshot( + ard <- ard_proportion_ci( + data = mtcars, + variables = cyl, + value = cyl ~ 10, + method = "jeffreys" + ) + ) +}) diff --git a/tests/testthat/test-ard_stats_t_test_onesample.R b/tests/testthat/test-ard_stats_t_test_onesample.R new file mode 100644 index 000000000..df62e11c2 --- /dev/null +++ b/tests/testthat/test-ard_stats_t_test_onesample.R @@ -0,0 +1,50 @@ +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) + +test_that("ard_stats_t_test_onesample() works", { + # first calculate an object to test against + expect_silent( + ard1 <- ard_stats_t_test_onesample( + cards::ADSL, + variables = AGE, + by = ARM, + conf.level = 0.9, + mu = 1 + ) + ) + + # first check arguments passed and returned correctly + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("mu", "conf.level")], + list(mu = 1, conf.level = 0.9) + ) + # check results are correct + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("estimate", "conf.low", "conf.high", "p.value")], + t.test( + cards::ADSL$AGE[cards::ADSL$ARM == "Placebo"], + conf.level = 0.9, + mu = 1 + ) |> + broom::tidy() |> + dplyr::select(c("estimate", "conf.low", "conf.high", "p.value")) |> + as.list() + ) + + # test the structure is good + expect_silent(cards::check_ard_structure(ard1)) + + # empty tibble returned with no variables + expect_equal( + ard_stats_t_test_onesample( + cards::ADSL, + variables = character(0) + ), + dplyr::tibble() + ) +}) diff --git a/tests/testthat/test-ard_stats_wilcox_test_onesample.R b/tests/testthat/test-ard_stats_wilcox_test_onesample.R new file mode 100644 index 000000000..3bd22c238 --- /dev/null +++ b/tests/testthat/test-ard_stats_wilcox_test_onesample.R @@ -0,0 +1,52 @@ +skip_if_not(is_pkg_installed("broom", reference_pkg = "cardx")) + +test_that("ard_stats_wilcox_test_onesample() works", { + # first calculate an object to test against + expect_silent( + ard1 <- ard_stats_wilcox_test_onesample( + cards::ADSL, + variables = AGE, + by = ARM, + conf.level = 0.9, + conf.int = TRUE, + mu = 1 + ) + ) + + # first check arguments passed and returned correctly + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("mu", "conf.level")], + list(mu = 1, conf.level = 0.9) + ) + # check results are correct + expect_equal( + cards::get_ard_statistics( + ard1, + group1_level %in% "Placebo" + )[c("estimate", "conf.low", "conf.high", "p.value")], + wilcox.test( + cards::ADSL$AGE[cards::ADSL$ARM == "Placebo"], + conf.level = 0.9, + mu = 1, + conf.int = TRUE + ) |> + broom::tidy() |> + dplyr::select(c("estimate", "conf.low", "conf.high", "p.value")) |> + as.list() + ) + + # test the structure is good + expect_silent(cards::check_ard_structure(ard1)) + + # empty tibble returned with no variables + expect_equal( + ard_stats_wilcox_test_onesample( + cards::ADSL, + variables = character(0) + ), + dplyr::tibble() + ) +}) diff --git a/tests/testthat/test-ard_survival_survfit_diff.R b/tests/testthat/test-ard_survival_survfit_diff.R new file mode 100644 index 000000000..e1f00dd9a --- /dev/null +++ b/tests/testthat/test-ard_survival_survfit_diff.R @@ -0,0 +1,63 @@ +skip_if_not(is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")) + +test_that("ard_survival_survfit_diff() works", { + withr::local_package("survival") + sf <- survfit(Surv(AVAL, 1 - CNSR) ~ SEX, cards::ADTTE) + expect_silent( + ard1 <- ard_survival_survfit_diff(sf, times = c(25, 50)) + ) + + # check the survival differences are accurate + expect_equal( + ard1 |> + dplyr::filter(variable_level == 25, stat_name == "estimate") |> + dplyr::pull(stat) |> + unlist(), + summary(sf, times = 25) |> + getElement("surv") |> + reduce(`-`) + ) + expect_equal( + ard1 |> + dplyr::filter(variable_level == 50, stat_name == "estimate") |> + dplyr::pull(stat) |> + unlist(), + summary(sf, times = 50) |> + getElement("surv") |> + reduce(`-`) + ) + + # check the structure of the ARD object + expect_silent( + cards::check_ard_structure(ard1) + ) +}) + +test_that("ard_survival_survfit_diff() messaging", { + withr::local_package("survival") + + # we can only do one stratifying variable at a time + expect_snapshot( + error = TRUE, + survfit(Surv(AVAL, 1 - CNSR) ~ SEX + TRTA, cards::ADTTE) |> + ard_survival_survfit_diff(times = c(25, 50)) + ) + + # the stratifying variable must have 2 or more levels + expect_snapshot( + error = TRUE, + survfit( + Surv(AVAL, 1 - CNSR) ~ constant, + cards::ADTTE |> dplyr::mutate(constant = 1L) + ) |> + ard_survival_survfit_diff(times = c(25, 50)) + ) + + # cannot pass a multi-state model or stratified Cox + expect_snapshot( + error = TRUE, + coxph(Surv(AVAL, CNSR) ~ SEX + strata(TRTA), cards::ADTTE) |> + survfit() |> + ard_survival_survfit_diff(times = c(25, 50)) + ) +}) diff --git a/tests/testthat/test-construction_helpers.R b/tests/testthat/test-construction_helpers.R index 8efbdb0bf..158e333ce 100644 --- a/tests/testthat/test-construction_helpers.R +++ b/tests/testthat/test-construction_helpers.R @@ -1,9 +1,9 @@ -skip_if_not(is_pkg_installed(c("broom.helpers", "withr", "survey"), reference_pkg = "cardx")) +skip_if_not(is_pkg_installed(c("broom.helpers", "withr", "survey", "survival"), reference_pkg = "cardx")) test_that("construct_model() works", { expect_snapshot( construct_model( - x = mtcars |> dplyr::rename(`M P G` = mpg), + data = mtcars |> dplyr::rename(`M P G` = mpg), formula = reformulate2(c("M P G", "cyl"), response = "hp"), method = "lm" ) |> @@ -30,8 +30,8 @@ test_that("construct_model() works", { "cannot be namespaced" ) - expect_equal( - { + # styler: off + expect_equal({ outside_fun <- function() { method.args <- list() @@ -44,10 +44,34 @@ test_that("construct_model() works", { coef() } - outside_fun() - }, + outside_fun()}, lm(mpg ~ cyl, mtcars) |> coef() ) + # styler: on + + # test function works when passing a function in `method=` + expect_equal( + construct_model( + data = mtcars, + method = lm, + formula = mpg ~ cyl + am + ) |> + ard_regression(), + lm(mpg ~ cyl + am, mtcars) |> + ard_regression() + ) + + # test function works when passing a namespaced function in `method=` + expect_equal( + construct_model( + data = mtcars, + method = survival::coxph, + formula = survival::Surv(mpg, am) ~ cyl + ) |> + ard_regression(), + survival::coxph(survival::Surv(mpg, am) ~ cyl, mtcars) |> + ard_regression() + ) # now the survey method ------- # styler: off @@ -68,3 +92,23 @@ test_that("construct_model() works", { ) # styler: on }) + +test_that("construct_model() messaging", { + expect_snapshot( + error = TRUE, + construct_model( + data = mtcars, + method = "survival::coxph", + formula = survival::Surv(mpg, am) ~ cyl + ) + ) + + expect_snapshot( + error = TRUE, + construct_model( + data = mtcars, + method = letters, + formula = am ~ cyl + ) + ) +})