From a0c8ee9660d2e1baa57f5944a535d76c3d6fe21e Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Wed, 6 Dec 2023 17:09:56 +0100 Subject: [PATCH] Add general default for `na_str` (#1145) Fixes #1113 --- NAMESPACE | 2 + NEWS.md | 2 + R/abnormal.R | 2 +- R/abnormal_by_marked.R | 2 +- R/abnormal_by_worst_grade.R | 2 +- R/abnormal_by_worst_grade_worsen.R | 2 +- R/analyze_variables.R | 4 +- R/analyze_vars_in_cols.R | 2 +- R/compare_variables.R | 2 +- R/count_cumulative.R | 2 +- R/count_missed_doses.R | 2 +- R/count_occurrences.R | 6 +- R/count_occurrences_by_grade.R | 4 +- R/count_patients_events_in_cols.R | 2 +- R/count_patients_with_event.R | 2 +- R/count_patients_with_flags.R | 2 +- R/count_values.R | 2 +- R/estimate_multinomial_rsp.R | 2 +- R/estimate_proportion.R | 2 +- R/h_biomarkers_subgroups.R | 2 +- R/h_response_biomarkers_subgroups.R | 2 +- R/h_survival_biomarkers_subgroups.R | 2 +- R/incidence_rate.R | 2 +- R/logistic_regression.R | 2 +- R/odds_ratio.R | 2 +- R/prop_diff.R | 2 +- R/prop_diff_test.R | 2 +- R/response_biomarkers_subgroups.R | 2 +- R/response_subgroups.R | 4 +- R/riskdiff.R | 2 +- R/summarize_ancova.R | 2 +- R/summarize_change.R | 2 +- R/summarize_colvars.R | 2 +- R/summarize_glm_count.R | 2 +- R/summarize_num_patients.R | 4 +- R/summarize_patients_exposure_in_cols.R | 4 +- R/survival_biomarkers_subgroups.R | 2 +- R/survival_coxph_pairwise.R | 2 +- R/survival_duration_subgroups.R | 4 +- R/survival_time.R | 4 +- R/survival_timepoint.R | 2 +- R/utils_rtables.R | 93 +++++++++++++++++-- _pkgdown.yml | 2 + inst/WORDLIST | 1 + man/abnormal.Rd | 2 +- man/abnormal_by_marked.Rd | 2 +- man/abnormal_by_worst_grade.Rd | 2 +- man/abnormal_by_worst_grade_worsen.Rd | 2 +- man/afun_riskdiff.Rd | 2 +- man/analyze_variables.Rd | 4 +- man/analyze_vars_in_cols.Rd | 2 +- man/compare_variables.Rd | 2 +- man/count_cumulative.Rd | 2 +- man/count_missed_doses.Rd | 2 +- man/count_occurrences.Rd | 6 +- man/count_occurrences_by_grade.Rd | 4 +- man/count_patients_events_in_cols.Rd | 2 +- man/count_patients_with_event.Rd | 2 +- man/count_patients_with_flags.Rd | 2 +- man/count_values_funs.Rd | 2 +- man/default_na_str.Rd | 56 +++++++++++ man/estimate_multinomial_rsp.Rd | 2 +- man/estimate_proportions.Rd | 2 +- man/h_response_biomarkers_subgroups.Rd | 2 +- man/h_survival_biomarkers_subgroups.Rd | 2 +- man/h_tab_one_biomarker.Rd | 2 +- man/incidence_rate.Rd | 2 +- man/labels_or_names.Rd | 2 +- man/logistic_summary_by_flag.Rd | 6 +- man/odds_ratio.Rd | 2 +- man/prop_diff.Rd | 2 +- man/prop_diff_test.Rd | 2 +- man/response_biomarkers_subgroups.Rd | 2 +- man/response_subgroups.Rd | 4 +- man/summarize_ancova.Rd | 2 +- man/summarize_change.Rd | 2 +- man/summarize_colvars.Rd | 2 +- man/summarize_glm_count.Rd | 2 +- man/summarize_num_patients.Rd | 4 +- man/summarize_patients_exposure_in_cols.Rd | 4 +- man/survival_biomarkers_subgroups.Rd | 2 +- man/survival_coxph_pairwise.Rd | 2 +- man/survival_duration_subgroups.Rd | 4 +- man/survival_time.Rd | 4 +- man/survival_timepoint.Rd | 2 +- man/to_string_matrix.Rd | 43 ++++++++- tests/testthat/_snaps/utils_rtables.md | 72 +++++++------- tests/testthat/test-analyze_variables.R | 8 +- .../test-count_occurrences_by_grade.R | 7 +- tests/testthat/test-prop_diff.R | 4 +- tests/testthat/test-summarize_ancova.R | 2 +- tests/testthat/test-summarize_num_patients.R | 7 +- .../test-survival_duration_subgroups.R | 4 +- tests/testthat/test-utils_rtables.R | 32 +++++++ 94 files changed, 377 insertions(+), 156 deletions(-) create mode 100644 man/default_na_str.Rd diff --git a/NAMESPACE b/NAMESPACE index db94d78830..9780039cdd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -89,6 +89,7 @@ export(d_test_proportion_diff) export(day2month) export(decorate_grob) export(decorate_grob_set) +export(default_na_str) export(df_explicit_na) export(draw_grob) export(estimate_incidence_rate) @@ -261,6 +262,7 @@ export(score_occurrences) export(score_occurrences_cols) export(score_occurrences_cont_cols) export(score_occurrences_subtable) +export(set_default_na_str) export(split_cols_by_groups) export(stack_grobs) export(stat_mean_ci) diff --git a/NEWS.md b/NEWS.md index 25b53583ef..fed351976c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,7 @@ * Added referential footnotes to `surv_time` for censored range observations, controlled via the `ref_fn_censor` parameter. * Added helper function `h_adlb_abnormal_by_worst_grade` to prepare `ADLB` data to use as input in `count_abnormal_by_worst_grade`. * Added function `rtable2gg` that converts `rtable` objects to `ggplot` objects. +* Added helper function to set default `na_str` globally with `set_default_na_str()` and added `default_na_str()` for all interested functions. ### Enhancements * Added `ref_group_coxph` parameter to `g_km` to specify the reference group used for pairwise Cox-PH calculations when `annot_coxph = TRUE`. @@ -29,6 +30,7 @@ ### Miscellaneous * Specified minimal version of package dependencies. +* Upgraded `to_string_matrix` to take into account `widths` and other printing parameters. # tern 0.9.2 diff --git a/R/abnormal.R b/R/abnormal.R index 78c46ef5d2..9fb2f5568a 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -147,7 +147,7 @@ count_abnormal <- function(lyt, abnormal = list(Low = "LOW", High = "HIGH"), variables = list(id = "USUBJID", baseline = "BNRIND"), exclude_base_abn = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = var, diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index a16882e25d..9e855113dd 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -200,7 +200,7 @@ count_abnormal_by_marked <- function(lyt, var, category = list(single = "SINGLE", last_replicated = c("LAST", "REPLICATED")), variables = list(id = "USUBJID", param = "PARAM", direction = "abn_dir"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., .stats = NULL, diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index 0e2c4246b8..1c03d6bf9e 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -139,7 +139,7 @@ count_abnormal_by_worst_grade <- function(lyt, param = "PARAM", grade_dir = "GRADE_DIR" ), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., .stats = NULL, diff --git a/R/abnormal_by_worst_grade_worsen.R b/R/abnormal_by_worst_grade_worsen.R index 120cb50dbe..a0a8c42b58 100644 --- a/R/abnormal_by_worst_grade_worsen.R +++ b/R/abnormal_by_worst_grade_worsen.R @@ -363,7 +363,7 @@ count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint baseline_var = "BTOXGR", direction_var = "GRADDR" ), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = NULL, diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 2bd4fab2b8..cb667455d7 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -482,7 +482,7 @@ a_summary <- function(x, .indent_mods = NULL, na.rm = TRUE, # nolint na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), ...) { extra_args <- list(...) if (lifecycle::is_present(na_level)) { @@ -671,7 +671,7 @@ analyze_vars <- function(lyt, vars, var_labels = vars, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., na.rm = TRUE, # nolint diff --git a/R/analyze_vars_in_cols.R b/R/analyze_vars_in_cols.R index 467dfd6554..5305b699f7 100644 --- a/R/analyze_vars_in_cols.R +++ b/R/analyze_vars_in_cols.R @@ -159,7 +159,7 @@ analyze_vars_in_cols <- function(lyt, cache = FALSE, .indent_mods = NULL, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, .formats = NULL, .aligns = NULL) { diff --git a/R/compare_variables.R b/R/compare_variables.R index 558964ed93..63ac6cf5d7 100644 --- a/R/compare_variables.R +++ b/R/compare_variables.R @@ -374,7 +374,7 @@ compare_vars <- function(lyt, vars, var_labels = vars, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., na.rm = TRUE, # nolint diff --git a/R/count_cumulative.R b/R/count_cumulative.R index 14399a43b9..70f18b8d84 100644 --- a/R/count_cumulative.R +++ b/R/count_cumulative.R @@ -157,7 +157,7 @@ count_cumulative <- function(lyt, include_eq = TRUE, var_labels = vars, show_labels = "visible", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/R/count_missed_doses.R b/R/count_missed_doses.R index 8698ad5f53..15505b4427 100644 --- a/R/count_missed_doses.R +++ b/R/count_missed_doses.R @@ -111,7 +111,7 @@ count_missed_doses <- function(lyt, thresholds, var_labels = vars, show_labels = "visible", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/R/count_occurrences.R b/R/count_occurrences.R index e001e09986..50359be558 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -148,7 +148,7 @@ a_count_occurrences <- function(df, .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_) { + na_str = default_na_str()) { denom <- match.arg(denom) x_stats <- s_count_occurrences( df = df, denom = denom, .N_col = .N_col, .df_row = .df_row, drop = drop, .var = .var, id = id @@ -216,7 +216,7 @@ count_occurrences <- function(lyt, var_labels = vars, show_labels = "hidden", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, @@ -282,7 +282,7 @@ summarize_occurrences <- function(lyt, id = "USUBJID", drop = TRUE, riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = "count_fraction_fixed_dp", .formats = NULL, diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index a6529da5be..9b544d64e3 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -276,7 +276,7 @@ count_occurrences_by_grade <- function(lyt, var_labels = var, show_labels = "default", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = var, @@ -355,7 +355,7 @@ summarize_occurrences_by_grade <- function(lyt, id = "USUBJID", grade_groups = list(), remove_single = TRUE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = NULL, .formats = NULL, diff --git a/R/count_patients_events_in_cols.R b/R/count_patients_events_in_cols.R index 6a788b215a..e1a9fb61ab 100644 --- a/R/count_patients_events_in_cols.R +++ b/R/count_patients_events_in_cols.R @@ -126,7 +126,7 @@ summarize_patients_events_in_cols <- function(lyt, # nolint id = "USUBJID", filters_list = list(), empty_stats = character(), - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = c( "unique", diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 65fdc4d99f..2753db2b6e 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -151,7 +151,7 @@ count_patients_with_event <- function(lyt, vars, filters, riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 21059680f2..e814dfcbfe 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -161,7 +161,7 @@ count_patients_with_flags <- function(lyt, var_labels = var, show_labels = "hidden", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = paste0("tbl_flags_", var), diff --git a/R/count_values.R b/R/count_values.R index 7204415794..74a2378d77 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -126,7 +126,7 @@ a_count_values <- make_afun( count_values <- function(lyt, vars, values, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/R/estimate_multinomial_rsp.R b/R/estimate_multinomial_rsp.R index b742c5ce8b..5f9f3b6b1a 100644 --- a/R/estimate_multinomial_rsp.R +++ b/R/estimate_multinomial_rsp.R @@ -146,7 +146,7 @@ a_length_proportion <- make_afun( #' @order 2 estimate_multinomial_response <- function(lyt, var, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/R/estimate_proportion.R b/R/estimate_proportion.R index 64ebb66ba9..2d97a4f13a 100644 --- a/R/estimate_proportion.R +++ b/R/estimate_proportion.R @@ -174,7 +174,7 @@ estimate_proportion <- function(lyt, max_iterations = 50, variables = list(strata = NULL), long = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/R/h_biomarkers_subgroups.R b/R/h_biomarkers_subgroups.R index cd316674fc..0e093ccd43 100644 --- a/R/h_biomarkers_subgroups.R +++ b/R/h_biomarkers_subgroups.R @@ -16,7 +16,7 @@ h_tab_one_biomarker <- function(df, afuns, colvars, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L, ...) { extra_args <- list(...) diff --git a/R/h_response_biomarkers_subgroups.R b/R/h_response_biomarkers_subgroups.R index f260330ce3..b183f831e2 100644 --- a/R/h_response_biomarkers_subgroups.R +++ b/R/h_response_biomarkers_subgroups.R @@ -185,7 +185,7 @@ h_logistic_mult_cont_df <- function(variables, #' @export h_tab_rsp_one_biomarker <- function(df, vars, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L) { afuns <- a_response_subgroups(na_str = na_str)[vars] colvars <- d_rsp_subgroups_colvars( diff --git a/R/h_survival_biomarkers_subgroups.R b/R/h_survival_biomarkers_subgroups.R index a08ffca35e..8246de2dde 100644 --- a/R/h_survival_biomarkers_subgroups.R +++ b/R/h_survival_biomarkers_subgroups.R @@ -197,7 +197,7 @@ h_coxreg_mult_cont_df <- function(variables, h_tab_surv_one_biomarker <- function(df, vars, time_unit, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L, ...) { afuns <- a_survival_subgroups(na_str = na_str)[vars] diff --git a/R/incidence_rate.R b/R/incidence_rate.R index 0abca36c32..2e1140ce38 100644 --- a/R/incidence_rate.R +++ b/R/incidence_rate.R @@ -137,7 +137,7 @@ estimate_incidence_rate <- function(lyt, vars, n_events, control = control_incidence_rate(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/R/logistic_regression.R b/R/logistic_regression.R index 898c390677..a605f71e82 100644 --- a/R/logistic_regression.R +++ b/R/logistic_regression.R @@ -335,7 +335,7 @@ logistic_regression_cols <- function(lyt, #' @return A content function. #' #' @export -logistic_summary_by_flag <- function(flag_var, na_str = NA_character_, .indent_mods = NULL) { +logistic_summary_by_flag <- function(flag_var, na_str = default_na_str(), .indent_mods = NULL) { checkmate::assert_string(flag_var) function(lyt) { cfun_list <- list( diff --git a/R/odds_ratio.R b/R/odds_ratio.R index 17c90918b0..7e0934f9d6 100644 --- a/R/odds_ratio.R +++ b/R/odds_ratio.R @@ -189,7 +189,7 @@ estimate_odds_ratio <- function(lyt, variables = list(arm = NULL, strata = NULL), conf_level = 0.95, groups_list = NULL, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/R/prop_diff.R b/R/prop_diff.R index 6db0514f49..333a527204 100644 --- a/R/prop_diff.R +++ b/R/prop_diff.R @@ -198,7 +198,7 @@ estimate_proportion_diff <- function(lyt, "strat_newcombe", "strat_newcombecc" ), weights_method = "cmh", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = vars, diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index dfe933b145..be377ab753 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -136,7 +136,7 @@ test_proportion_diff <- function(lyt, vars, variables = list(strata = NULL), method = c("chisq", "schouten", "fisher", "cmh"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = vars, diff --git a/R/response_biomarkers_subgroups.R b/R/response_biomarkers_subgroups.R index 9b0750b224..aeccb242a2 100644 --- a/R/response_biomarkers_subgroups.R +++ b/R/response_biomarkers_subgroups.R @@ -68,7 +68,7 @@ #' @name response_biomarkers_subgroups tabulate_rsp_biomarkers <- function(df, vars = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L) { checkmate::assert_data_frame(df) checkmate::assert_character(df$biomarker) diff --git a/R/response_subgroups.R b/R/response_subgroups.R index aa6d55c477..9b2d253af1 100644 --- a/R/response_subgroups.R +++ b/R/response_subgroups.R @@ -124,7 +124,7 @@ a_response_subgroups <- function(.formats = list( ci = list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)" # nolint end ), - na_str = NA_character_) { + na_str = default_na_str()) { checkmate::assert_list(.formats) checkmate::assert_subset( names(.formats), @@ -198,7 +198,7 @@ tabulate_rsp_subgroups <- function(lyt, vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), label_all = "All Patients", - na_str = NA_character_) { + na_str = default_na_str()) { conf_level <- df$or$conf_level[1] method <- if ("pval_label" %in% names(df$or)) { df$or$pval_label[1] diff --git a/R/riskdiff.R b/R/riskdiff.R index d1be5816da..1be194ddac 100644 --- a/R/riskdiff.R +++ b/R/riskdiff.R @@ -95,7 +95,7 @@ afun_riskdiff <- function(df, .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_, + na_str = default_na_str(), afun, s_args = list()) { if (!any(grepl("riskdiff", names(.spl_context)))) { diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index 411daddd96..4203c2a84f 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -240,7 +240,7 @@ summarize_ancova <- function(lyt, interaction_y = FALSE, interaction_item = NULL, var_labels, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "visible", diff --git a/R/summarize_change.R b/R/summarize_change.R index aead1df4f6..5aaff1eabe 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -114,7 +114,7 @@ a_change_from_baseline <- make_afun( summarize_change <- function(lyt, vars, variables, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/R/summarize_colvars.R b/R/summarize_colvars.R index 7bae286108..aa9fae0ebb 100644 --- a/R/summarize_colvars.R +++ b/R/summarize_colvars.R @@ -63,7 +63,7 @@ summarize_colvars <- function(lyt, ..., na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), .stats = c("n", "mean_sd", "median", "range", "count_fraction"), .formats = NULL, .labels = NULL, diff --git a/R/summarize_glm_count.R b/R/summarize_glm_count.R index 6292136e58..63b4150221 100644 --- a/R/summarize_glm_count.R +++ b/R/summarize_glm_count.R @@ -405,7 +405,7 @@ summarize_glm_count <- function(lyt, weights = stats::weights, scale = 1, var_labels, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "visible", diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 137bd7d175..21617a1fc3 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -143,7 +143,7 @@ summarize_num_patients <- function(lyt, required = NULL, count_by = NULL, unique_count_suffix = TRUE, - na_str = NA_character_, + na_str = default_na_str(), .stats = NULL, .formats = NULL, .labels = c( @@ -233,7 +233,7 @@ analyze_num_patients <- function(lyt, required = NULL, count_by = NULL, unique_count_suffix = TRUE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, .stats = NULL, .formats = NULL, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index dbe20c5d51..c8e6d25dc6 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -170,7 +170,7 @@ summarize_patients_exposure_in_cols <- function(lyt, # nolint add_total_level = FALSE, custom_label = NULL, col_split = TRUE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = c("n_patients", "sum_exposure"), .labels = c(n_patients = "Patients", sum_exposure = "Person time"), @@ -273,7 +273,7 @@ analyze_patients_exposure_in_cols <- function(lyt, # nolint add_total_level = FALSE, custom_label = NULL, col_split = TRUE, - na_str = NA_character_, + na_str = default_na_str(), .stats = c("n_patients", "sum_exposure"), .labels = c(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = 0L, diff --git a/R/survival_biomarkers_subgroups.R b/R/survival_biomarkers_subgroups.R index 3f6465ca54..6753c4ffa8 100644 --- a/R/survival_biomarkers_subgroups.R +++ b/R/survival_biomarkers_subgroups.R @@ -185,7 +185,7 @@ tabulate_survival_biomarkers <- function(df, control = control_coxreg(), label_all = "All Patients", time_unit = NULL, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L) { checkmate::assert_data_frame(df) checkmate::assert_character(df$biomarker) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index 2103df3da6..2b62d8e150 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -166,7 +166,7 @@ a_coxph_pairwise <- make_afun( #' @order 2 coxph_pairwise <- function(lyt, vars, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = "CoxPH", diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 6e4a4b6e44..8f04f5240f 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -149,7 +149,7 @@ a_survival_subgroups <- function(.formats = list( # nolint start ci = list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)" ), - na_str = NA_character_) { # nolint end + na_str = default_na_str()) { # nolint end checkmate::assert_list(.formats) checkmate::assert_subset( names(.formats), @@ -213,7 +213,7 @@ tabulate_survival_subgroups <- function(lyt, groups_lists = list(), label_all = "All Patients", time_unit = NULL, - na_str = NA_character_) { + na_str = default_na_str()) { conf_level <- df$hr$conf_level[1] method <- df$hr$pval_label[1] diff --git a/R/survival_time.R b/R/survival_time.R index 99f91c5d52..1da9809603 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -111,7 +111,7 @@ a_surv_time <- function(df, .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_) { + na_str = default_na_str()) { x_stats <- s_surv_time( df = df, .var = .var, is_event = is_event, control = control ) @@ -185,7 +185,7 @@ surv_time <- function(lyt, is_event, control = control_surv_time(), ref_fn_censor = TRUE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = "Time to Event", diff --git a/R/survival_timepoint.R b/R/survival_timepoint.R index 4c1ef79dca..9a9458d196 100644 --- a/R/survival_timepoint.R +++ b/R/survival_timepoint.R @@ -232,7 +232,7 @@ surv_timepoint <- function(lyt, is_event, control = control_surv_timepoint(), method = c("surv", "surv_diff", "both"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names_suffix = "", diff --git a/R/utils_rtables.R b/R/utils_rtables.R index 5cbcebd6d6..761284e226 100644 --- a/R/utils_rtables.R +++ b/R/utils_rtables.R @@ -1,3 +1,5 @@ +# Utility functions to cooperate with {rtables} package + #' Convert Table into Matrix of Strings #' #' @description `r lifecycle::badge("stable")` @@ -7,23 +9,48 @@ #' `print_txt_to_copy` instead facilitate the testing development by returning a well #' formatted text that needs only to be copied and pasted in the expected output. #' +#' @inheritParams formatters::toString #' @param x `rtables` table. -#' @param with_spaces Should the tested table keep the indentation and other relevant spaces? -#' @param print_txt_to_copy Utility to have a way to copy the input table directly +#' @param with_spaces (`logical`)\cr should the tested table keep the indentation and other relevant spaces? +#' @param print_txt_to_copy (`logical`)\cr utility to have a way to copy the input table directly #' into the expected variable instead of copying it too manually. #' -#' @return A `matrix` of `string`s. +#' @return A `matrix` of `string`s. If `print_txt_to_copy = TRUE` the well formatted printout of the +#' table will be printed to console, ready to be copied as a expected value. +#' +#' @examples +#' tbl <- basic_table() %>% +#' split_rows_by("SEX") %>% +#' split_cols_by("ARM") %>% +#' analyze("AGE") %>% +#' build_table(tern_ex_adsl) +#' +#' to_string_matrix(tbl, widths = ceiling(propose_column_widths(tbl) / 2)) #' #' @export -to_string_matrix <- function(x, with_spaces = FALSE, print_txt_to_copy = FALSE) { +to_string_matrix <- function(x, widths = NULL, max_width = NULL, + hsep = formatters::default_hsep(), + with_spaces = TRUE, print_txt_to_copy = FALSE) { checkmate::assert_flag(with_spaces) checkmate::assert_flag(print_txt_to_copy) + checkmate::assert_int(max_width, null.ok = TRUE) + + if (inherits(x, "MatrixPrintForm")) { + tx <- x + } else { + tx <- matrix_form(x, TRUE) + } + + tf_wrap <- FALSE + if (!is.null(max_width)) { + tf_wrap <- TRUE + } # Producing the matrix to test if (with_spaces) { - out <- strsplit(toString(matrix_form(x, TRUE)), "\\n")[[1]] + out <- strsplit(toString(tx, widths = widths, tf_wrap = tf_wrap, max_width = max_width, hsep = hsep), "\\n")[[1]] } else { - out <- matrix_form(x)$string + out <- tx$string } # Printing to console formatted output that needs to be copied in "expected" @@ -197,7 +224,7 @@ h_col_indices <- function(table_tree, col_names) { #' Internal helper function for working with nested statistic function results which typically #' don't have labels but names that we can use. #' -#' @param x a list +#' @param x a list. #' #' @return A `character` vector with the labels or names for the list elements. #' @@ -388,3 +415,55 @@ append_varlabels <- function(lyt, df, vars, indent = 0L) { append_topleft(lyt, lab) } + +#' Default string replacement for `NA` values +#' +#' @description `r lifecycle::badge("stable")` +#' +#' The default string used to represent `NA` values. This value is used as the default +#' value for the `na_str` argument throughout the `tern` package, and printed in place +#' of `NA` values in output tables. If not specified for each `tern` function by the user +#' via the `na_str` argument, or in the R environment options via [set_default_na_str()], +#' then `NA` is used. +#' +#' @param na_str (`string`)\cr Single string value to set in the R environment options as +#' the default value to replace `NA`s. Use `getOption("tern_default_na_str")` to check the +#' current value set in the R environment (defaults to `NULL` if not set). +#' +#' @name default_na_str +NULL + +#' @describeIn default_na_str Getter for default `NA` value replacement string. +#' +#' @return +#' * `default_na_str` returns the current value if an R environment option has been set +#' for `"tern_default_na_str"`, or `NA_character_` otherwise. +#' +#' @examples +#' # Default settings +#' default_na_str() +#' getOption("tern_default_na_str") +#' +#' # Set custom value +#' set_default_na_str("") +#' +#' # Settings after value has been set +#' default_na_str() +#' getOption("tern_default_na_str") +#' +#' @export +default_na_str <- function() { + getOption("tern_default_na_str", default = NA_character_) +} + +#' @describeIn default_na_str Setter for default `NA` value replacement string. Sets the +#' option `"tern_default_na_str"` within the R environment. +#' +#' @return +#' * `set_default_na_str` has no return value. +#' +#' @export +set_default_na_str <- function(na_str) { + checkmate::assert_character(na_str, len = 1, null.ok = TRUE) + options("tern_default_na_str" = na_str) +} diff --git a/_pkgdown.yml b/_pkgdown.yml index 33e4fdd090..7241190b4d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -110,6 +110,8 @@ reference: - add_riskdiff - add_rowcounts - append_varlabels + - default_na_str + - set_default_na_str - starts_with("as.rtable") - starts_with("combine_") - starts_with("h_col_") diff --git a/inst/WORDLIST b/inst/WORDLIST index 2ac1b864de..5f67a2d233 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -4,6 +4,7 @@ Biomarkers Bové Clopper Forkers +Getter Haenszel Hauck Hoffmann diff --git a/man/abnormal.Rd b/man/abnormal.Rd index 9966f74c8f..ad57fcc038 100644 --- a/man/abnormal.Rd +++ b/man/abnormal.Rd @@ -13,7 +13,7 @@ count_abnormal( abnormal = list(Low = "LOW", High = "HIGH"), variables = list(id = "USUBJID", baseline = "BNRIND"), exclude_base_abn = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = var, diff --git a/man/abnormal_by_marked.Rd b/man/abnormal_by_marked.Rd index cb28c5b5ef..d4e31a7e5e 100644 --- a/man/abnormal_by_marked.Rd +++ b/man/abnormal_by_marked.Rd @@ -12,7 +12,7 @@ count_abnormal_by_marked( var, category = list(single = "SINGLE", last_replicated = c("LAST", "REPLICATED")), variables = list(id = "USUBJID", param = "PARAM", direction = "abn_dir"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., .stats = NULL, diff --git a/man/abnormal_by_worst_grade.Rd b/man/abnormal_by_worst_grade.Rd index 52cec2a313..55af401e99 100644 --- a/man/abnormal_by_worst_grade.Rd +++ b/man/abnormal_by_worst_grade.Rd @@ -11,7 +11,7 @@ count_abnormal_by_worst_grade( lyt, var, variables = list(id = "USUBJID", param = "PARAM", grade_dir = "GRADE_DIR"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., .stats = NULL, diff --git a/man/abnormal_by_worst_grade_worsen.Rd b/man/abnormal_by_worst_grade_worsen.Rd index 31d61b1845..d8c45a1a2f 100644 --- a/man/abnormal_by_worst_grade_worsen.Rd +++ b/man/abnormal_by_worst_grade_worsen.Rd @@ -11,7 +11,7 @@ count_abnormal_lab_worsen_by_baseline( lyt, var, variables = list(id = "USUBJID", baseline_var = "BTOXGR", direction_var = "GRADDR"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = NULL, diff --git a/man/afun_riskdiff.Rd b/man/afun_riskdiff.Rd index 372d5732bc..bf0483e859 100644 --- a/man/afun_riskdiff.Rd +++ b/man/afun_riskdiff.Rd @@ -17,7 +17,7 @@ afun_riskdiff( .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_, + na_str = default_na_str(), afun, s_args = list() ) diff --git a/man/analyze_variables.Rd b/man/analyze_variables.Rd index 665ce85358..bc5f676f6e 100644 --- a/man/analyze_variables.Rd +++ b/man/analyze_variables.Rd @@ -17,7 +17,7 @@ analyze_vars( vars, var_labels = vars, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., na.rm = TRUE, @@ -87,7 +87,7 @@ a_summary( .indent_mods = NULL, na.rm = TRUE, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), ... ) diff --git a/man/analyze_vars_in_cols.Rd b/man/analyze_vars_in_cols.Rd index 84ba43ecc8..fda9d51550 100644 --- a/man/analyze_vars_in_cols.Rd +++ b/man/analyze_vars_in_cols.Rd @@ -19,7 +19,7 @@ analyze_vars_in_cols( cache = FALSE, .indent_mods = NULL, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, .formats = NULL, .aligns = NULL diff --git a/man/compare_variables.Rd b/man/compare_variables.Rd index c0d2ad908c..9ed22a114f 100644 --- a/man/compare_variables.Rd +++ b/man/compare_variables.Rd @@ -16,7 +16,7 @@ compare_vars( vars, var_labels = vars, na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., na.rm = TRUE, diff --git a/man/count_cumulative.Rd b/man/count_cumulative.Rd index c43e52da5c..ba65ddc44d 100644 --- a/man/count_cumulative.Rd +++ b/man/count_cumulative.Rd @@ -14,7 +14,7 @@ count_cumulative( include_eq = TRUE, var_labels = vars, show_labels = "visible", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/man/count_missed_doses.Rd b/man/count_missed_doses.Rd index 0ba661a0b2..7eb13c2096 100644 --- a/man/count_missed_doses.Rd +++ b/man/count_missed_doses.Rd @@ -13,7 +13,7 @@ count_missed_doses( thresholds, var_labels = vars, show_labels = "visible", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/man/count_occurrences.Rd b/man/count_occurrences.Rd index cd57e68172..c1c26fbfd1 100644 --- a/man/count_occurrences.Rd +++ b/man/count_occurrences.Rd @@ -15,7 +15,7 @@ count_occurrences( var_labels = vars, show_labels = "hidden", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, @@ -31,7 +31,7 @@ summarize_occurrences( id = "USUBJID", drop = TRUE, riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = "count_fraction_fixed_dp", .formats = NULL, @@ -62,7 +62,7 @@ a_count_occurrences( .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_ + na_str = default_na_str() ) } \arguments{ diff --git a/man/count_occurrences_by_grade.Rd b/man/count_occurrences_by_grade.Rd index 0eb833e414..04c357d8e6 100644 --- a/man/count_occurrences_by_grade.Rd +++ b/man/count_occurrences_by_grade.Rd @@ -16,7 +16,7 @@ count_occurrences_by_grade( var_labels = var, show_labels = "default", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = var, @@ -32,7 +32,7 @@ summarize_occurrences_by_grade( id = "USUBJID", grade_groups = list(), remove_single = TRUE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = NULL, .formats = NULL, diff --git a/man/count_patients_events_in_cols.Rd b/man/count_patients_events_in_cols.Rd index 7d0df4cd40..91e4c07f55 100644 --- a/man/count_patients_events_in_cols.Rd +++ b/man/count_patients_events_in_cols.Rd @@ -11,7 +11,7 @@ summarize_patients_events_in_cols( id = "USUBJID", filters_list = list(), empty_stats = character(), - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = c("unique", "all", names(filters_list)), .labels = c(unique = "Patients (All)", all = "Events (All)", diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index 3cb1a4620e..970bec6ba8 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -11,7 +11,7 @@ count_patients_with_event( vars, filters, riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/man/count_patients_with_flags.Rd b/man/count_patients_with_flags.Rd index 00a8a23bf8..63febf254b 100644 --- a/man/count_patients_with_flags.Rd +++ b/man/count_patients_with_flags.Rd @@ -14,7 +14,7 @@ count_patients_with_flags( var_labels = var, show_labels = "hidden", riskdiff = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = paste0("tbl_flags_", var), diff --git a/man/count_values_funs.Rd b/man/count_values_funs.Rd index 0bd2537cd6..af569d9fc6 100644 --- a/man/count_values_funs.Rd +++ b/man/count_values_funs.Rd @@ -14,7 +14,7 @@ count_values( lyt, vars, values, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/man/default_na_str.Rd b/man/default_na_str.Rd new file mode 100644 index 0000000000..c7a578c0d5 --- /dev/null +++ b/man/default_na_str.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils_rtables.R +\name{default_na_str} +\alias{default_na_str} +\alias{set_default_na_str} +\title{Default string replacement for \code{NA} values} +\usage{ +default_na_str() + +set_default_na_str(na_str) +} +\arguments{ +\item{na_str}{(\code{string})\cr Single string value to set in the R environment options as +the default value to replace \code{NA}s. Use \code{getOption("tern_default_na_str")} to check the +current value set in the R environment (defaults to \code{NULL} if not set).} +} +\value{ +\itemize{ +\item \code{default_na_str} returns the current value if an R environment option has been set +for \code{"tern_default_na_str"}, or \code{NA_character_} otherwise. +} + +\itemize{ +\item \code{set_default_na_str} has no return value. +} +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +The default string used to represent \code{NA} values. This value is used as the default +value for the \code{na_str} argument throughout the \code{tern} package, and printed in place +of \code{NA} values in output tables. If not specified for each \code{tern} function by the user +via the \code{na_str} argument, or in the R environment options via \code{\link[=set_default_na_str]{set_default_na_str()}}, +then \code{NA} is used. +} +\section{Functions}{ +\itemize{ +\item \code{default_na_str()}: Getter for default \code{NA} value replacement string. + +\item \code{set_default_na_str()}: Setter for default \code{NA} value replacement string. Sets the +option \code{"tern_default_na_str"} within the R environment. + +}} +\examples{ +# Default settings +default_na_str() +getOption("tern_default_na_str") + +# Set custom value +set_default_na_str("") + +# Settings after value has been set +default_na_str() +getOption("tern_default_na_str") + +} diff --git a/man/estimate_multinomial_rsp.Rd b/man/estimate_multinomial_rsp.Rd index 0413b9b17b..88b8e705e2 100644 --- a/man/estimate_multinomial_rsp.Rd +++ b/man/estimate_multinomial_rsp.Rd @@ -10,7 +10,7 @@ estimate_multinomial_response( lyt, var, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/man/estimate_proportions.Rd b/man/estimate_proportions.Rd index 6b574d0ad6..50accd31bc 100644 --- a/man/estimate_proportions.Rd +++ b/man/estimate_proportions.Rd @@ -17,7 +17,7 @@ estimate_proportion( max_iterations = 50, variables = list(strata = NULL), long = FALSE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/man/h_response_biomarkers_subgroups.Rd b/man/h_response_biomarkers_subgroups.Rd index bd2cca19eb..ee11a77692 100644 --- a/man/h_response_biomarkers_subgroups.Rd +++ b/man/h_response_biomarkers_subgroups.Rd @@ -11,7 +11,7 @@ h_rsp_to_logistic_variables(variables, biomarker) h_logistic_mult_cont_df(variables, data, control = control_logistic()) -h_tab_rsp_one_biomarker(df, vars, na_str = NA_character_, .indent_mods = 0L) +h_tab_rsp_one_biomarker(df, vars, na_str = default_na_str(), .indent_mods = 0L) } \arguments{ \item{variables}{(named \code{list} of \code{string})\cr list of additional analysis variables.} diff --git a/man/h_survival_biomarkers_subgroups.Rd b/man/h_survival_biomarkers_subgroups.Rd index 18e5a23418..58956fab70 100644 --- a/man/h_survival_biomarkers_subgroups.Rd +++ b/man/h_survival_biomarkers_subgroups.Rd @@ -15,7 +15,7 @@ h_tab_surv_one_biomarker( df, vars, time_unit, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L, ... ) diff --git a/man/h_tab_one_biomarker.Rd b/man/h_tab_one_biomarker.Rd index 6e5997c94f..315faff18e 100644 --- a/man/h_tab_one_biomarker.Rd +++ b/man/h_tab_one_biomarker.Rd @@ -8,7 +8,7 @@ h_tab_one_biomarker( df, afuns, colvars, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L, ... ) diff --git a/man/incidence_rate.Rd b/man/incidence_rate.Rd index 6712e11117..cc89860604 100644 --- a/man/incidence_rate.Rd +++ b/man/incidence_rate.Rd @@ -12,7 +12,7 @@ estimate_incidence_rate( vars, n_events, control = control_incidence_rate(), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/man/labels_or_names.Rd b/man/labels_or_names.Rd index 828104ea26..79fb6c6727 100644 --- a/man/labels_or_names.Rd +++ b/man/labels_or_names.Rd @@ -7,7 +7,7 @@ labels_or_names(x) } \arguments{ -\item{x}{a list} +\item{x}{a list.} } \value{ A \code{character} vector with the labels or names for the list elements. diff --git a/man/logistic_summary_by_flag.Rd b/man/logistic_summary_by_flag.Rd index a43bc956aa..d4993dda0d 100644 --- a/man/logistic_summary_by_flag.Rd +++ b/man/logistic_summary_by_flag.Rd @@ -4,7 +4,11 @@ \alias{logistic_summary_by_flag} \title{Logistic Regression Summary Table Constructor Function} \usage{ -logistic_summary_by_flag(flag_var, na_str = NA_character_, .indent_mods = NULL) +logistic_summary_by_flag( + flag_var, + na_str = default_na_str(), + .indent_mods = NULL +) } \arguments{ \item{flag_var}{(\code{string})\cr variable name identifying which row should be used in this diff --git a/man/odds_ratio.Rd b/man/odds_ratio.Rd index d4153854ce..a276567c4b 100644 --- a/man/odds_ratio.Rd +++ b/man/odds_ratio.Rd @@ -13,7 +13,7 @@ estimate_odds_ratio( variables = list(arm = NULL, strata = NULL), conf_level = 0.95, groups_list = NULL, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "hidden", diff --git a/man/prop_diff.Rd b/man/prop_diff.Rd index 72b728936e..515a41869d 100644 --- a/man/prop_diff.Rd +++ b/man/prop_diff.Rd @@ -15,7 +15,7 @@ estimate_proportion_diff( method = c("waldcc", "wald", "cmh", "ha", "newcombe", "newcombecc", "strat_newcombe", "strat_newcombecc"), weights_method = "cmh", - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = vars, diff --git a/man/prop_diff_test.Rd b/man/prop_diff_test.Rd index fc3f42a8fb..7e197bfb9f 100644 --- a/man/prop_diff_test.Rd +++ b/man/prop_diff_test.Rd @@ -12,7 +12,7 @@ test_proportion_diff( vars, variables = list(strata = NULL), method = c("chisq", "schouten", "fisher", "cmh"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = vars, diff --git a/man/response_biomarkers_subgroups.Rd b/man/response_biomarkers_subgroups.Rd index 24fe28baef..66800e3ead 100644 --- a/man/response_biomarkers_subgroups.Rd +++ b/man/response_biomarkers_subgroups.Rd @@ -8,7 +8,7 @@ tabulate_rsp_biomarkers( df, vars = c("n_tot", "n_rsp", "prop", "or", "ci", "pval"), - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L ) } diff --git a/man/response_subgroups.Rd b/man/response_subgroups.Rd index f987ef793c..e2f0458778 100644 --- a/man/response_subgroups.Rd +++ b/man/response_subgroups.Rd @@ -12,14 +12,14 @@ tabulate_rsp_subgroups( vars = c("n_tot", "n", "prop", "or", "ci"), groups_lists = list(), label_all = "All Patients", - na_str = NA_character_ + na_str = default_na_str() ) a_response_subgroups( .formats = list(n = "xx", n_rsp = "xx", prop = "xx.x\%", n_tot = "xx", or = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)"), - na_str = NA_character_ + na_str = default_na_str() ) } \arguments{ diff --git a/man/summarize_ancova.Rd b/man/summarize_ancova.Rd index 0603da3707..a1907d57ec 100644 --- a/man/summarize_ancova.Rd +++ b/man/summarize_ancova.Rd @@ -14,7 +14,7 @@ summarize_ancova( interaction_y = FALSE, interaction_item = NULL, var_labels, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "visible", diff --git a/man/summarize_change.Rd b/man/summarize_change.Rd index f568828462..405200ad50 100644 --- a/man/summarize_change.Rd +++ b/man/summarize_change.Rd @@ -10,7 +10,7 @@ summarize_change( lyt, vars, variables, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names = vars, diff --git a/man/summarize_colvars.Rd b/man/summarize_colvars.Rd index 7b2573c9e8..7dc25936c6 100644 --- a/man/summarize_colvars.Rd +++ b/man/summarize_colvars.Rd @@ -8,7 +8,7 @@ summarize_colvars( lyt, ..., na_level = lifecycle::deprecated(), - na_str = NA_character_, + na_str = default_na_str(), .stats = c("n", "mean_sd", "median", "range", "count_fraction"), .formats = NULL, .labels = NULL, diff --git a/man/summarize_glm_count.Rd b/man/summarize_glm_count.Rd index 78d18bfafb..54714f9edb 100644 --- a/man/summarize_glm_count.Rd +++ b/man/summarize_glm_count.Rd @@ -16,7 +16,7 @@ summarize_glm_count( weights = stats::weights, scale = 1, var_labels, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., show_labels = "visible", diff --git a/man/summarize_num_patients.Rd b/man/summarize_num_patients.Rd index 4ea0cc22b9..266317024d 100644 --- a/man/summarize_num_patients.Rd +++ b/man/summarize_num_patients.Rd @@ -13,7 +13,7 @@ analyze_num_patients( required = NULL, count_by = NULL, unique_count_suffix = TRUE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, .stats = NULL, .formats = NULL, @@ -32,7 +32,7 @@ summarize_num_patients( required = NULL, count_by = NULL, unique_count_suffix = TRUE, - na_str = NA_character_, + na_str = default_na_str(), .stats = NULL, .formats = NULL, .labels = c(unique = "Number of patients with at least one event", nonunique = diff --git a/man/summarize_patients_exposure_in_cols.Rd b/man/summarize_patients_exposure_in_cols.Rd index b0a0050150..33bca4d846 100644 --- a/man/summarize_patients_exposure_in_cols.Rd +++ b/man/summarize_patients_exposure_in_cols.Rd @@ -15,7 +15,7 @@ analyze_patients_exposure_in_cols( add_total_level = FALSE, custom_label = NULL, col_split = TRUE, - na_str = NA_character_, + na_str = default_na_str(), .stats = c("n_patients", "sum_exposure"), .labels = c(n_patients = "Patients", sum_exposure = "Person time"), .indent_mods = 0L, @@ -30,7 +30,7 @@ summarize_patients_exposure_in_cols( add_total_level = FALSE, custom_label = NULL, col_split = TRUE, - na_str = NA_character_, + na_str = default_na_str(), ..., .stats = c("n_patients", "sum_exposure"), .labels = c(n_patients = "Patients", sum_exposure = "Person time"), diff --git a/man/survival_biomarkers_subgroups.Rd b/man/survival_biomarkers_subgroups.Rd index f78d430a07..68dd6dbeb5 100644 --- a/man/survival_biomarkers_subgroups.Rd +++ b/man/survival_biomarkers_subgroups.Rd @@ -12,7 +12,7 @@ tabulate_survival_biomarkers( control = control_coxreg(), label_all = "All Patients", time_unit = NULL, - na_str = NA_character_, + na_str = default_na_str(), .indent_mods = 0L ) } diff --git a/man/survival_coxph_pairwise.Rd b/man/survival_coxph_pairwise.Rd index 2ed3fefb07..bfbcfaab03 100644 --- a/man/survival_coxph_pairwise.Rd +++ b/man/survival_coxph_pairwise.Rd @@ -10,7 +10,7 @@ coxph_pairwise( lyt, vars, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = "CoxPH", diff --git a/man/survival_duration_subgroups.Rd b/man/survival_duration_subgroups.Rd index f16759be4e..1dfbba4804 100644 --- a/man/survival_duration_subgroups.Rd +++ b/man/survival_duration_subgroups.Rd @@ -13,14 +13,14 @@ tabulate_survival_subgroups( groups_lists = list(), label_all = "All Patients", time_unit = NULL, - na_str = NA_character_ + na_str = default_na_str() ) a_survival_subgroups( .formats = list(n = "xx", n_events = "xx", n_tot_events = "xx", median = "xx.x", n_tot = "xx", hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)"), - na_str = NA_character_ + na_str = default_na_str() ) } \arguments{ diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 3ed3e27d92..fc12f88481 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -13,7 +13,7 @@ surv_time( is_event, control = control_surv_time(), ref_fn_censor = TRUE, - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., var_labels = "Time to Event", @@ -39,7 +39,7 @@ a_surv_time( .formats = NULL, .labels = NULL, .indent_mods = NULL, - na_str = NA_character_ + na_str = default_na_str() ) } \arguments{ diff --git a/man/survival_timepoint.Rd b/man/survival_timepoint.Rd index 5af5915da4..ef95d3ea9c 100644 --- a/man/survival_timepoint.Rd +++ b/man/survival_timepoint.Rd @@ -16,7 +16,7 @@ surv_timepoint( is_event, control = control_surv_timepoint(), method = c("surv", "surv_diff", "both"), - na_str = NA_character_, + na_str = default_na_str(), nested = TRUE, ..., table_names_suffix = "", diff --git a/man/to_string_matrix.Rd b/man/to_string_matrix.Rd index 9ccb9ad524..0816f1fd02 100644 --- a/man/to_string_matrix.Rd +++ b/man/to_string_matrix.Rd @@ -4,18 +4,43 @@ \alias{to_string_matrix} \title{Convert Table into Matrix of Strings} \usage{ -to_string_matrix(x, with_spaces = FALSE, print_txt_to_copy = FALSE) +to_string_matrix( + x, + widths = NULL, + max_width = NULL, + hsep = formatters::default_hsep(), + with_spaces = TRUE, + print_txt_to_copy = FALSE +) } \arguments{ \item{x}{\code{rtables} table.} -\item{with_spaces}{Should the tested table keep the indentation and other relevant spaces?} +\item{widths}{numeric (or \code{NULL}). (proposed) widths for the columns +of \code{x}. The expected length of this numeric vector can be +retrieved with \code{ncol() + 1} as the column of row names must +also be considered.} -\item{print_txt_to_copy}{Utility to have a way to copy the input table directly +\item{max_width}{integer(1), character(1) or \code{NULL}. Width that title +and footer (including footnotes) materials should be +word-wrapped to. If \code{NULL}, it is set to the current print width +of the session (\code{getOption("width")}). If set to \code{"auto"}, +the width of the table (plus any table inset) is used. Ignored +completely if \code{tf_wrap} is \code{FALSE}.} + +\item{hsep}{character(1). Characters to repeat to create +header/body separator line. If \code{NULL}, the object value will be +used. If \code{" "}, an empty separator will be printed. Check \code{\link[formatters:default_hsep]{default_hsep()}} +for more information.} + +\item{with_spaces}{(\code{logical})\cr should the tested table keep the indentation and other relevant spaces?} + +\item{print_txt_to_copy}{(\code{logical})\cr utility to have a way to copy the input table directly into the expected variable instead of copying it too manually.} } \value{ -A \code{matrix} of \code{string}s. +A \code{matrix} of \code{string}s. If \code{print_txt_to_copy = TRUE} the well formatted printout of the +table will be printed to console, ready to be copied as a expected value. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} @@ -25,3 +50,13 @@ to test not only for content but also indentation and table structure. \code{print_txt_to_copy} instead facilitate the testing development by returning a well formatted text that needs only to be copied and pasted in the expected output. } +\examples{ +tbl <- basic_table() \%>\% + split_rows_by("SEX") \%>\% + split_cols_by("ARM") \%>\% + analyze("AGE") \%>\% + build_table(tern_ex_adsl) + +to_string_matrix(tbl, widths = ceiling(propose_column_widths(tbl) / 2)) + +} diff --git a/tests/testthat/_snaps/utils_rtables.md b/tests/testthat/_snaps/utils_rtables.md index 80ad82cf17..d21246d816 100644 --- a/tests/testthat/_snaps/utils_rtables.md +++ b/tests/testthat/_snaps/utils_rtables.md @@ -6,26 +6,26 @@ [,1] [,2] [,3] [,4] [1,] "" "A: Drug X" "B: Placebo" "C: Combination" [2,] "ASIAN" "" "" "" - [3,] "A" "" "" "" - [4,] "mean" "32.19" "33.90" "36.81" - [5,] "B" "" "" "" - [6,] "mean" "34.12" "31.62" "34.73" - [7,] "C" "" "" "" - [8,] "mean" "36.21" "33.00" "32.39" + [3,] " A" "" "" "" + [4,] " mean" "32.19" "33.90" "36.81" + [5,] " B" "" "" "" + [6,] " mean" "34.12" "31.62" "34.73" + [7,] " C" "" "" "" + [8,] " mean" "36.21" "33.00" "32.39" [9,] "BLACK OR AFRICAN AMERICAN" "" "" "" - [10,] "A" "" "" "" - [11,] "mean" "31.50" "28.57" "33.62" - [12,] "B" "" "" "" - [13,] "mean" "35.60" "30.83" "33.67" - [14,] "C" "" "" "" - [15,] "mean" "35.50" "34.18" "35.00" + [10,] " A" "" "" "" + [11,] " mean" "31.50" "28.57" "33.62" + [12,] " B" "" "" "" + [13,] " mean" "35.60" "30.83" "33.67" + [14,] " C" "" "" "" + [15,] " mean" "35.50" "34.18" "35.00" [16,] "WHITE" "" "" "" - [17,] "A" "" "" "" - [18,] "mean" "37.67" "31.33" "33.17" - [19,] "B" "" "" "" - [20,] "mean" "39.86" "39.00" "34.75" - [21,] "C" "" "" "" - [22,] "mean" "39.75" "44.67" "36.75" + [17,] " A" "" "" "" + [18,] " mean" "37.67" "31.33" "33.17" + [19,] " B" "" "" "" + [20,] " mean" "39.86" "39.00" "34.75" + [21,] " C" "" "" "" + [22,] " mean" "39.75" "44.67" "36.75" --- @@ -64,26 +64,26 @@ [1] "c(" [2] " \"\", \"A: Drug X\", \"B: Placebo\", \"C: Combination\"," [3] " \"ASIAN\", \"\", \"\", \"\"," - [4] " \"A\", \"\", \"\", \"\"," - [5] " \"mean\", \"32.19\", \"33.90\", \"36.81\"," - [6] " \"B\", \"\", \"\", \"\"," - [7] " \"mean\", \"34.12\", \"31.62\", \"34.73\"," - [8] " \"C\", \"\", \"\", \"\"," - [9] " \"mean\", \"36.21\", \"33.00\", \"32.39\"," + [4] " \" A\", \"\", \"\", \"\"," + [5] " \" mean\", \"32.19\", \"33.90\", \"36.81\"," + [6] " \" B\", \"\", \"\", \"\"," + [7] " \" mean\", \"34.12\", \"31.62\", \"34.73\"," + [8] " \" C\", \"\", \"\", \"\"," + [9] " \" mean\", \"36.21\", \"33.00\", \"32.39\"," [10] " \"BLACK OR AFRICAN AMERICAN\", \"\", \"\", \"\"," - [11] " \"A\", \"\", \"\", \"\"," - [12] " \"mean\", \"31.50\", \"28.57\", \"33.62\"," - [13] " \"B\", \"\", \"\", \"\"," - [14] " \"mean\", \"35.60\", \"30.83\", \"33.67\"," - [15] " \"C\", \"\", \"\", \"\"," - [16] " \"mean\", \"35.50\", \"34.18\", \"35.00\"," + [11] " \" A\", \"\", \"\", \"\"," + [12] " \" mean\", \"31.50\", \"28.57\", \"33.62\"," + [13] " \" B\", \"\", \"\", \"\"," + [14] " \" mean\", \"35.60\", \"30.83\", \"33.67\"," + [15] " \" C\", \"\", \"\", \"\"," + [16] " \" mean\", \"35.50\", \"34.18\", \"35.00\"," [17] " \"WHITE\", \"\", \"\", \"\"," - [18] " \"A\", \"\", \"\", \"\"," - [19] " \"mean\", \"37.67\", \"31.33\", \"33.17\"," - [20] " \"B\", \"\", \"\", \"\"," - [21] " \"mean\", \"39.86\", \"39.00\", \"34.75\"," - [22] " \"C\", \"\", \"\", \"\"," - [23] " \"mean\", \"39.75\", \"44.67\", \"36.75\"" + [18] " \" A\", \"\", \"\", \"\"," + [19] " \" mean\", \"37.67\", \"31.33\", \"33.17\"," + [20] " \" B\", \"\", \"\", \"\"," + [21] " \" mean\", \"39.86\", \"39.00\", \"34.75\"," + [22] " \" C\", \"\", \"\", \"\"," + [23] " \" mean\", \"39.75\", \"44.67\", \"36.75\"" [24] ")" --- diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index e0f67a376d..afd4f3ef0b 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -160,7 +160,7 @@ testthat::test_that("a_summary work with healthy input.", { x <- rnorm(10) result <- a_summary( x = x, .N_col = 10, .N_row = 20, .var = "bla", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, - compare = FALSE, .stats = get_stats("analyze_vars_numeric"), na.rm = TRUE, na_str = NA_character_ + compare = FALSE, .stats = get_stats("analyze_vars_numeric"), na.rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) @@ -175,7 +175,7 @@ testthat::test_that("a_summary work with healthy input.", { result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = "bla", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = NA_character_ + na.rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) @@ -190,7 +190,7 @@ testthat::test_that("a_summary work with healthy input.", { result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = "x", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = NA_character_, + na.rm = TRUE, na_str = default_na_str(), verbose = FALSE ) res_out <- testthat::expect_silent(result) @@ -206,7 +206,7 @@ testthat::test_that("a_summary work with healthy input.", { result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = NULL, .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = NA_character_ + na.rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) diff --git a/tests/testthat/test-count_occurrences_by_grade.R b/tests/testthat/test-count_occurrences_by_grade.R index a5c045267e..3cdf0b9c86 100644 --- a/tests/testthat/test-count_occurrences_by_grade.R +++ b/tests/testthat/test-count_occurrences_by_grade.R @@ -341,10 +341,13 @@ testthat::test_that("summarize_ and count_occurrences_by_grade works with pagina pag_result <- paginate_table(result, lpp = 20) testthat::expect_identical( - to_string_matrix(pag_result[[1]])[3:4, 1], + to_string_matrix(pag_result[[1]], with_spaces = FALSE, print_txt_to_copy = FALSE)[3:4, 1], c("-Any-", "Grade 1-2") ) - testthat::expect_identical(to_string_matrix(pag_result[[2]])[3, 1], "A") + testthat::expect_identical( + to_string_matrix(pag_result[[2]], with_spaces = FALSE, print_txt_to_copy = FALSE)[3, 1], + " A" + ) }) testthat::test_that("count_occurrences_by_grade works as expected with risk difference column", { diff --git a/tests/testthat/test-prop_diff.R b/tests/testthat/test-prop_diff.R index cdb27d8e08..c6cdcc92db 100644 --- a/tests/testthat/test-prop_diff.R +++ b/tests/testthat/test-prop_diff.R @@ -296,11 +296,11 @@ testthat::test_that("`estimate_proportion_diff` and strat_newcombe is compatible method = "strat_newcombe" ) result <- build_table(l, df = dta) - result <- to_string_matrix(result) + result <- to_string_matrix(result, with_spaces = FALSE, print_txt_to_copy = FALSE) expected <- structure( c( "", "Difference in Response rate (%)", - "95% CI (Stratified Newcombe, without correction)", + " 95% CI (Stratified Newcombe, without correction)", "B", "", "", "A", "25.39", "(3.47, 44.54)" ), .Dim = c(3L, 3L) diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index 1095d6862a..f2b12a3d9e 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -130,7 +130,7 @@ testthat::test_that("summarize_ancova works with interaction", { interaction_item = "p_group" ) %>% build_table(iris_new) - result_matrix <- to_string_matrix(result) + result_matrix <- to_string_matrix(result, with_spaces = FALSE, print_txt_to_copy = FALSE) lm_fit <- stats::lm(formula = "Petal.Length ~ Sepal.Width + p_group + Species*p_group + Species", data = iris_new) emmeans_fit <- emmeans::emmeans(lm_fit, specs = c("Species", "p_group"), data = iris_new) diff --git a/tests/testthat/test-summarize_num_patients.R b/tests/testthat/test-summarize_num_patients.R index 2d0d38755e..3af6119549 100644 --- a/tests/testthat/test-summarize_num_patients.R +++ b/tests/testthat/test-summarize_num_patients.R @@ -245,13 +245,16 @@ testthat::test_that("analyze_num_patients works well for pagination", { # Pagination tests (no repetition of the first lines) pag_result <- paginate_table(result, lpp = 10) testthat::expect_identical( - to_string_matrix(pag_result[[1]])[3:4, 1], + to_string_matrix(pag_result[[1]], with_spaces = FALSE, print_txt_to_copy = FALSE)[3:4, 1], c( "Number of patients with at least one event", "Number of events" ) ) - testthat::expect_identical(to_string_matrix(pag_result[[3]])[6, 1], "17") + testthat::expect_identical( + to_string_matrix(pag_result[[3]], with_spaces = FALSE, print_txt_to_copy = FALSE)[6, 1], + " 17" + ) }) testthat::test_that("summarize_num_patients works as expected with risk difference column", { diff --git a/tests/testthat/test-survival_duration_subgroups.R b/tests/testthat/test-survival_duration_subgroups.R index 883449191e..feb3728e4d 100644 --- a/tests/testthat/test-survival_duration_subgroups.R +++ b/tests/testthat/test-survival_duration_subgroups.R @@ -188,7 +188,9 @@ testthat::test_that("tabulate_survival_subgroups works correctly with both `n_to testthat::expect_snapshot(res) # Check header of table. - result_header_both_survtime <- to_string_matrix(result_both_survtime)[2, ] + result_header_both_survtime <- to_string_matrix(result_both_survtime, + with_spaces = FALSE, print_txt_to_copy = FALSE + )[2, ] res <- testthat::expect_silent(result_header_both_survtime) testthat::expect_snapshot(res) diff --git a/tests/testthat/test-utils_rtables.R b/tests/testthat/test-utils_rtables.R index 5e5300816e..ac88966fad 100644 --- a/tests/testthat/test-utils_rtables.R +++ b/tests/testthat/test-utils_rtables.R @@ -260,3 +260,35 @@ testthat::test_that("append_varlabels correctly concatenates multiple variable l res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("default na_str works properly", { + tmp <- tern_ex_adsl[seq_len(10), seq_len(10)] + tmp$AGE[1] <- NA + df_to_tt(tmp) + set_default_na_str("N/A") + tbl <- basic_table() %>% + split_rows_by("SEX") %>% + split_cols_by("ARM") %>% + analyze("AGE", + afun = function(x) mean(x, na.rm = FALSE), inclNAs = TRUE, + format = "xx.", na_str = default_na_str() + ) %>% + build_table(tmp) + testthat::expect_identical(matrix_form(tbl)$strings[5, 2], "N/A") + + + # lets try with some default function + set_default_na_str(NULL) + dt <- data.frame("VAR" = c(NA, NA_real_)) + tbl <- basic_table() %>% + analyze_vars(vars = "VAR", .stats = c("n", "mean")) %>% + build_table(dt) + testthat::expect_identical(matrix_form(tbl)$strings[-1, 2], c("0", "NA")) + + set_default_na_str("") + dt <- data.frame("VAR" = c(NA, NA_real_)) + tbl <- basic_table() %>% + analyze_vars(vars = "VAR", .stats = c("n", "mean")) %>% + build_table(dt) + testthat::expect_identical(matrix_form(tbl)$strings[-1, 2], c("0", "")) +})