diff --git a/DESCRIPTION b/DESCRIPTION index a912c42f1e..3f7deea84c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: tern Title: Create Common TLGs Used in Clinical Trials -Version: 0.9.1.9001 -Date: 2023-10-05 +Version: 0.9.1.9006 +Date: 2023-10-16 Authors@R: c( person("Joe", "Zhu", , "joe.zhu@roche.com", role = c("aut", "cre")), person("Daniel", "Sabanés Bové", , "daniel.sabanes_bove@roche.com", role = "aut"), diff --git a/NEWS.md b/NEWS.md index 000665507d..dfe7ae1775 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,7 @@ -# tern 0.9.1.9001 +# tern 0.9.1.9006 + +### New Features +* Added the `na_str` argument to `analyze` & `summarize_row_groups` wrapper functions `count_abnormal`, `count_abnormal_by_baseline`, `count_abnormal_by_marked`, `count_abnormal_by_worst_grade`, `count_abnormal_lab_worsen_by_baseline`, `count_cumulative`, `count_missed_doses`, `count_occurrences`, `count_occurrences_by_grade`, `summarize_occurrences_by_grade`, `summarize_patients_events_in_cols`, `count_patients_with_event`, `count_patients_with_flags`, `count_values`, `estimate_multinomial_response`, `estimate_proportion`, `h_tab_one_biomarker`, `estimate_incidence_rate`, `logistic_summary_by_flag`, `estimate_odds_ratio`, `estimate_proportion_diff`, `test_proportion_diff`, `summarize_ancova`, `summarize_change`, `summarize_glm_count`, `summarize_num_patients`, `analyze_num_patients`, `summarize_patients_exposure_in_cols`, `coxph_pairwise`, `tabulate_survival_subgroups`, `surv_time`, and `surv_timepoint`. ### New Features * Added function `get_indents_from_stats` to format and return indent modifiers for a given set of statistics. @@ -6,6 +9,13 @@ ### Enhancements * Added formatting function `format_count_fraction_lt10` for formatting `count_fraction` with special consideration when count is less than 10. +* Updated `s_summary.logical` output for `count_fraction` when denominator is zero to display as `NA` instead of `0` in tables. + +### Bug Fixes +* Fixed bug in `g_km` causing an error when converting certain annotation width units. + +### Miscellaneous +* Began deprecation of `na_level` argument in `s_count_abnormal_by_baseline`, `a_summary`, `analyze_vars`, `analyze_vars_in_cols`, `compare_vars`, `h_map_for_count_abnormal`, `h_stack_by_baskets`, `summarize_colvars`, `a_coxreg`, and `summarize_coxreg` and replaced it with the `na_str` argument. # tern 0.9.1 @@ -16,7 +26,7 @@ * Added function `get_stats` to return methods from given statistical method groups. * Added function `get_formats_from_stats` to return formats and `get_labels_from_stats` to return labels for a given set of statistics. * Added `"auto"` option for `.formats`. It uses `format_auto` to determine automatically the number of digits. -* Added `title` argument to `h_grob_tbl_at_risk` and `annot_at_risk_title` argument to `g_km` and `h_km_layout` which allows user to add "Patients at Risk" title to Kaplan-Meier at risk annotation table. +* Added `title` argument to `h_grob_tbl_at_risk` and `annot_at_risk_title` argument to `g_km` and `h_km_layout` which allows user to add "Patients at Risk" title to Kaplan-Meier at risk annotation table. ### Enhancements * Refactored `tabulate_rsp_subgroups` to pass sanitation checks by preventing creation of degenerate subtables. diff --git a/R/abnormal.R b/R/abnormal.R index 168f2e7c79..ec337dd3ee 100644 --- a/R/abnormal.R +++ b/R/abnormal.R @@ -140,6 +140,7 @@ a_count_abnormal <- make_afun( #' @export count_abnormal <- function(lyt, var, + na_str = NA_character_, nested = TRUE, ..., table_names = var, @@ -162,6 +163,7 @@ count_abnormal <- function(lyt, lyt = lyt, vars = var, afun = afun, + na_str = na_str, nested = nested, table_names = table_names, extra_args = list(...), diff --git a/R/abnormal_by_baseline.R b/R/abnormal_by_baseline.R index 9cea4bde1b..b308a74162 100644 --- a/R/abnormal_by_baseline.R +++ b/R/abnormal_by_baseline.R @@ -57,7 +57,7 @@ d_count_abnormal_by_baseline <- function(abnormal) { #' @describeIn abnormal_by_baseline Statistics function for a single `abnormal` level. #' -#' @param na_level (`string`)\cr the explicit `na_level` argument you used in the pre-processing steps (maybe with +#' @param na_str (`string`)\cr the explicit `na_level` argument you used in the pre-processing steps (maybe with #' [df_explicit_na()]). The default is `""`. #' #' @return @@ -69,11 +69,17 @@ d_count_abnormal_by_baseline <- function(abnormal) { s_count_abnormal_by_baseline <- function(df, .var, abnormal, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", variables = list(id = "USUBJID", baseline = "BNRIND")) { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "s_count_abnormal_by_baseline(na_level)", "s_count_abnormal_by_baseline(na_str)") + na_str <- na_level + } + checkmate::assert_string(.var) checkmate::assert_string(abnormal) - checkmate::assert_string(na_level) + checkmate::assert_string(na_str) assert_df_with_variables(df, c(range = .var, variables)) checkmate::assert_subset(names(variables), c("id", "baseline")) checkmate::assert_multi_class(df[[variables$id]], classes = c("factor", "character")) @@ -81,14 +87,14 @@ s_count_abnormal_by_baseline <- function(df, checkmate::assert_multi_class(df[[.var]], classes = c("factor", "character")) # If input is passed as character, changed to factor - df[[.var]] <- as_factor_keep_attributes(df[[.var]], na_level = na_level) - df[[variables$baseline]] <- as_factor_keep_attributes(df[[variables$baseline]], na_level = na_level) + df[[.var]] <- as_factor_keep_attributes(df[[.var]], na_level = na_str) + df[[variables$baseline]] <- as_factor_keep_attributes(df[[variables$baseline]], na_level = na_str) assert_valid_factor(df[[.var]], any.missing = FALSE) assert_valid_factor(df[[variables$baseline]], any.missing = FALSE) # Keep only records with valid analysis value. - df <- df[df[[.var]] != na_level, ] + df <- df[df[[.var]] != na_str, ] anl <- data.frame( id = df[[variables$id]], @@ -104,7 +110,7 @@ s_count_abnormal_by_baseline <- function(df, total_num <- length(unique(anl$id[anl$var == abnormal])) # Baseline NA records are counted only in total rows. - anl <- anl[anl$baseline != na_level, ] + anl <- anl[anl$baseline != na_str, ] # Abnormal: # - Patients in denominator: have abnormality at baseline. @@ -183,6 +189,7 @@ a_count_abnormal_by_baseline <- make_afun( count_abnormal_by_baseline <- function(lyt, var, abnormal, + na_str = "", nested = TRUE, ..., table_names = abnormal, @@ -207,9 +214,10 @@ count_abnormal_by_baseline <- function(lyt, vars = var, var_labels = names(abn), afun = afun, + na_str = na_str, nested = nested, table_names = table_names[i], - extra_args = c(list(abnormal = abn), list(...)), + extra_args = c(list(abnormal = abn, na_str = na_str), list(...)), show_labels = "visible" ) } diff --git a/R/abnormal_by_marked.R b/R/abnormal_by_marked.R index 85c5fc1031..ffcaee38ba 100644 --- a/R/abnormal_by_marked.R +++ b/R/abnormal_by_marked.R @@ -196,6 +196,7 @@ a_count_abnormal_by_marked <- make_afun( #' @export count_abnormal_by_marked <- function(lyt, var, + na_str = NA_character_, nested = TRUE, ..., .stats = NULL, @@ -217,6 +218,7 @@ count_abnormal_by_marked <- function(lyt, lyt = lyt, vars = var, afun = afun, + na_str = na_str, nested = nested, show_labels = "hidden", extra_args = c(list(...)) diff --git a/R/abnormal_by_worst_grade.R b/R/abnormal_by_worst_grade.R index 0addbb1e0c..4328730d52 100644 --- a/R/abnormal_by_worst_grade.R +++ b/R/abnormal_by_worst_grade.R @@ -164,6 +164,7 @@ a_count_abnormal_by_worst_grade <- make_afun( # nolint #' @export count_abnormal_by_worst_grade <- function(lyt, var, + na_str = NA_character_, nested = TRUE, ..., .stats = NULL, @@ -182,6 +183,7 @@ count_abnormal_by_worst_grade <- function(lyt, lyt = lyt, vars = var, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = "hidden" diff --git a/R/abnormal_by_worst_grade_worsen.R b/R/abnormal_by_worst_grade_worsen.R index 8979598eea..120dc107a2 100644 --- a/R/abnormal_by_worst_grade_worsen.R +++ b/R/abnormal_by_worst_grade_worsen.R @@ -356,6 +356,7 @@ a_count_abnormal_lab_worsen_by_baseline <- make_afun( # nolint #' @export count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint var, + na_str = NA_character_, nested = TRUE, ..., table_names = NULL, @@ -377,6 +378,7 @@ count_abnormal_lab_worsen_by_baseline <- function(lyt, # nolint lyt = lyt, vars = var, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = "hidden" diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 82086e7051..b44e4c16a5 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -261,7 +261,8 @@ s_summary.numeric <- function(x, #' #' ## Basic usage: #' s_summary(factor(c("a", "a", "b", "c", "a"))) -#' # Empty factor returns NA-filled items. +#' +#' # Empty factor returns zero-filled items. #' s_summary(factor(levels = c("a", "b", "c"))) #' #' ## Management of NA values. @@ -382,6 +383,9 @@ s_summary.character <- function(x, #' ## Basic usage: #' s_summary(c(TRUE, FALSE, TRUE, TRUE)) #' +#' # Empty factor returns zero-filled items. +#' s_summary(as.logical(c())) +#' #' ## Management of NA values. #' x <- c(NA, TRUE, FALSE) #' s_summary(x, na.rm = TRUE) @@ -410,7 +414,7 @@ s_summary.logical <- function(x, N_col = .N_col ) y$count <- count - y$count_fraction <- c(count, ifelse(dn > 0, count / dn, NA)) + y$count_fraction <- c(count, ifelse(dn > 0, count / dn, 0)) y$n_blq <- 0L y } @@ -465,8 +469,14 @@ a_summary <- function(x, .labels = NULL, .indent_mods = NULL, na.rm = TRUE, # nolint - na_level = NA_character_, + na_level = lifecycle::deprecated(), + na_str = NA_character_, ...) { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "a_summary(na_level)", "a_summary(na_str)") + na_str <- na_level + } + if (is.numeric(x)) { type <- "numeric" if (!is.null(.stats) && any(grepl("^pval", .stats))) { @@ -543,7 +553,7 @@ a_summary <- function(x, .names = .labels, .labels = .labels, .indent_mods = .indent_mods, - .format_na_strs = na_level + .format_na_strs = na_str ) } @@ -670,10 +680,11 @@ create_afun_summary <- function(.stats, .formats, .labels, .indent_mods) { analyze_vars <- function(lyt, vars, var_labels = vars, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, ..., na.rm = TRUE, # nolint - na_level = NA_character_, show_labels = "default", table_names = vars, section_div = NA_character_, @@ -681,7 +692,12 @@ analyze_vars <- function(lyt, .formats = NULL, .labels = NULL, .indent_mods = NULL) { - extra_args <- list(.stats = .stats, na.rm = na.rm, na_level = na_level, ...) + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "analyze_vars(na_level)", "analyze_vars(na_str)") + na_str <- na_level + } + + extra_args <- list(.stats = .stats, na.rm = na.rm, na_str = na_str, ...) if (!is.null(.formats)) extra_args[[".formats"]] <- .formats if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods @@ -691,6 +707,7 @@ analyze_vars <- function(lyt, vars = vars, var_labels = var_labels, afun = a_summary, + na_str = na_str, nested = nested, extra_args = extra_args, inclNAs = TRUE, diff --git a/R/analyze_vars_in_cols.R b/R/analyze_vars_in_cols.R index ed52cddf36..9d4a29fbce 100644 --- a/R/analyze_vars_in_cols.R +++ b/R/analyze_vars_in_cols.R @@ -158,11 +158,17 @@ analyze_vars_in_cols <- function(lyt, avalcat_var = "AVALCAT1", cache = FALSE, .indent_mods = NULL, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, - na_level = NULL, .formats = NULL, .aligns = NULL) { - checkmate::assert_string(na_level, null.ok = TRUE) + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "analyze_vars_in_cols(na_level)", "analyze_vars_in_cols(na_str)") + na_str <- na_level + } + + checkmate::assert_string(na_str, na.ok = TRUE, null.ok = TRUE) checkmate::assert_character(row_labels, null.ok = TRUE) checkmate::assert_int(.indent_mods, null.ok = TRUE) checkmate::assert_flag(nested) @@ -244,7 +250,7 @@ analyze_vars_in_cols <- function(lyt, imp_rule = imp_rule, post = as.numeric(tail(.spl_context$value, 1)) > 0, avalcat_var = avalcat_var ) res <- res_imp[["val"]] - na_level <- res_imp[["na_level"]] + na_str <- res_imp[["na_str"]] } # Label check and replacement @@ -267,7 +273,7 @@ analyze_vars_in_cols <- function(lyt, rcell(res, label = lbl, format = formats_v[names(formats_v) == stat][[1]], - format_na_str = na_level, + format_na_str = na_str, indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods), align = .aligns ) @@ -283,6 +289,7 @@ analyze_vars_in_cols <- function(lyt, lyt = lyt, var = unique(vars), cfun = cfun_list, + na_str = na_str, extra_args = list(...) ) } else { @@ -311,7 +318,7 @@ analyze_vars_in_cols <- function(lyt, imp_rule = imp_rule, post = as.numeric(tail(.spl_context$value, 1)) > 0, avalcat_var = avalcat_var ) res <- res_imp[["val"]] - na_level <- res_imp[["na_level"]] + na_str <- res_imp[["na_str"]] } if (is.list(res)) { @@ -349,7 +356,7 @@ analyze_vars_in_cols <- function(lyt, rcell(res, label = lbl, format = formats_v[names(formats_v) == stat][[1]], - format_na_str = na_level, + format_na_str = na_str, indent_mod = ifelse(is.null(.indent_mods), 0L, .indent_mods), align = .aligns ) diff --git a/R/argument_convention.R b/R/argument_convention.R index 51df26b86c..99f82245d8 100644 --- a/R/argument_convention.R +++ b/R/argument_convention.R @@ -9,22 +9,22 @@ #' @param .all_col_counts (`vector` of `integer`)\cr each value represents a global count for a column. Values are #' taken from `alt_counts_df` if specified (see [rtables::build_table()]). #' @param .df_row (`data.frame`)\cr data frame across all of the columns for the given row split. +#' @param .formats (named `character` or `list`)\cr formats for the statistics. See Details in `analyze_vars` for more +#' information on the `"auto"` setting. #' @param .in_ref_col (`logical`)\cr `TRUE` when working with the reference level, `FALSE` otherwise. +#' @param .indent_mods (named `integer`)\cr indent modifiers for the labels. Defaults to 0, which corresponds to the +#' unmodified default behavior. Can be negative. +#' @param .labels (named `character`)\cr labels for the statistics (without indent). #' @param .N_col (`integer`)\cr column-wise N (column count) for the full column being analyzed that is typically #' passed by `rtables`. #' @param .N_row (`integer`)\cr row-wise N (row group count) for the group of observations being analyzed #' (i.e. with no column-based subsetting) that is typically passed by `rtables`. #' @param .ref_group (`data.frame` or `vector`)\cr the data corresponding to the reference group. +#' @param .spl_context (`data.frame`)\cr gives information about ancestor split states +#' that is passed by `rtables`. #' @param .stats (`character`)\cr statistics to select for the table. -#' @param .indent_mods (named `integer`)\cr indent modifiers for the labels. Defaults to 0, which corresponds to the -#' unmodified default behavior. Can be negative. -#' @param .formats (named `character` or `list`)\cr formats for the statistics. See Details in `analyze_vars` for more -#' information on the `"auto"` setting. -#' @param .labels (named `character`)\cr labels for the statistics (without indent). #' @param .var (`string`)\cr single variable name that is passed by `rtables` when requested #' by a statistics function. -#' @param .spl_context (`data.frame`)\cr gives information about ancestor split states -#' that is passed by `rtables`. #' @param add_total_level (`flag`)\cr adds a "total" level after the others which includes all the levels #' that constitute the split. A custom label can be set for this level via the `custom_label` argument. #' @param col_by (`factor`)\cr defining column groups. @@ -48,7 +48,7 @@ #' @param method (`string`)\cr specifies the test used to calculate the p-value for the difference between #' two proportions. For options, see [s_test_proportion_diff()]. Default is `NULL` so no test is performed. #' @param na.rm (`flag`)\cr whether `NA` values should be removed from `x` prior to analysis. -#' @param na_level (`string`)\cr string used to replace all `NA` or empty values in the output. +#' @param na_level `r lifecycle::badge("deprecated")` Please use the `na_str` argument instead. #' @param na_str (`string`)\cr string used to replace all `NA` or empty values in the output. #' @param nested (`flag`)\cr whether this layout instruction should be applied within the existing layout structure _if #' possible_ (`TRUE`, the default) or as a new top-level element (`FALSE`). Ignored if it would nest a split. diff --git a/R/compare_variables.R b/R/compare_variables.R index ff3a7356a4..e82eda8459 100644 --- a/R/compare_variables.R +++ b/R/compare_variables.R @@ -368,10 +368,11 @@ create_afun_compare <- function(.stats = NULL, compare_vars <- function(lyt, vars, var_labels = vars, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, ..., na.rm = TRUE, # nolint - na_level = NA_character_, show_labels = "default", table_names = vars, section_div = NA_character_, @@ -379,7 +380,12 @@ compare_vars <- function(lyt, .formats = NULL, .labels = NULL, .indent_mods = NULL) { - extra_args <- list(.stats = .stats, na.rm = na.rm, na_level = na_level, compare = TRUE, ...) + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "compare_vars(na_level)", "compare_vars(na_str)") + na_str <- na_level + } + + extra_args <- list(.stats = .stats, na.rm = na.rm, na_str = na_str, compare = TRUE, ...) if (!is.null(.formats)) extra_args[[".formats"]] <- .formats if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods @@ -389,6 +395,7 @@ compare_vars <- function(lyt, vars = vars, var_labels = var_labels, afun = a_summary, + na_str = na_str, nested = nested, extra_args = extra_args, inclNAs = TRUE, diff --git a/R/count_cumulative.R b/R/count_cumulative.R index db2c1456a2..4f94ba5d86 100644 --- a/R/count_cumulative.R +++ b/R/count_cumulative.R @@ -151,6 +151,7 @@ count_cumulative <- function(lyt, vars, var_labels = vars, show_labels = "visible", + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -170,6 +171,7 @@ count_cumulative <- function(lyt, lyt, vars, afun = afun, + na_str = na_str, table_names = table_names, var_labels = var_labels, show_labels = show_labels, diff --git a/R/count_missed_doses.R b/R/count_missed_doses.R index 8d861a030e..735acb5460 100644 --- a/R/count_missed_doses.R +++ b/R/count_missed_doses.R @@ -112,6 +112,7 @@ count_missed_doses <- function(lyt, vars, var_labels = vars, show_labels = "visible", + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -134,6 +135,7 @@ count_missed_doses <- function(lyt, var_labels = var_labels, table_names = table_names, show_labels = show_labels, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 0faa12ec25..677458f416 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -252,6 +252,7 @@ count_occurrences <- function(lyt, var_labels = var_labels, show_labels = show_labels, table_names = table_names, + na_str = na_str, nested = nested, extra_args = extra_args ) diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index 1f83f703c7..9b67fc7278 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -269,6 +269,7 @@ count_occurrences_by_grade <- function(lyt, var_labels = var, show_labels = "default", riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = var, @@ -304,6 +305,7 @@ count_occurrences_by_grade <- function(lyt, show_labels = show_labels, afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), table_names = table_names, + na_str = na_str, nested = nested, extra_args = extra_args ) @@ -340,6 +342,7 @@ count_occurrences_by_grade <- function(lyt, #' @export summarize_occurrences_by_grade <- function(lyt, var, + na_str = NA_character_, ..., .stats = NULL, .formats = NULL, @@ -358,6 +361,7 @@ summarize_occurrences_by_grade <- function(lyt, lyt = lyt, var = var, cfun = cfun, + na_str = na_str, extra_args = list(...) ) } diff --git a/R/count_patients_events_in_cols.R b/R/count_patients_events_in_cols.R index 8ebab8ae4a..5eb601aaf4 100644 --- a/R/count_patients_events_in_cols.R +++ b/R/count_patients_events_in_cols.R @@ -122,6 +122,7 @@ s_count_patients_and_multiple_events <- function(df, # nolint summarize_patients_events_in_cols <- function(lyt, # nolint id = "USUBJID", filters_list = list(), + na_str = NA_character_, ..., .stats = c( "unique", @@ -156,6 +157,7 @@ summarize_patients_events_in_cols <- function(lyt, # nolint summarize_row_groups( lyt = lyt, cfun = afun_list, + na_str = na_str, extra_args = list(...) ) } diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index 359c8c2302..92cc42edba 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -145,6 +145,7 @@ a_count_patients_with_event <- make_afun( count_patients_with_event <- function(lyt, vars, riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -177,6 +178,7 @@ count_patients_with_event <- function(lyt, lyt, vars, afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), + na_str = na_str, nested = nested, extra_args = extra_args, show_labels = ifelse(length(vars) > 1, "visible", "hidden"), diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 1b3e6cf396..e7580b34cf 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -158,6 +158,7 @@ count_patients_with_flags <- function(lyt, var_labels = var, show_labels = "hidden", riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = paste0("tbl_flags_", var), @@ -192,6 +193,7 @@ count_patients_with_flags <- function(lyt, show_labels = show_labels, afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), table_names = table_names, + na_str = na_str, nested = nested, extra_args = extra_args ) diff --git a/R/count_values.R b/R/count_values.R index 35b866e96f..ebbf8068dd 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -122,6 +122,7 @@ a_count_values <- make_afun( count_values <- function(lyt, vars, values, + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -140,6 +141,7 @@ count_values <- function(lyt, lyt, vars, afun = afun, + na_str = na_str, nested = nested, extra_args = c(list(values = values), list(...)), show_labels = ifelse(length(vars) > 1, "visible", "hidden"), diff --git a/R/estimate_multinomial_rsp.R b/R/estimate_multinomial_rsp.R index 8a3c1124cb..fb3fafff16 100644 --- a/R/estimate_multinomial_rsp.R +++ b/R/estimate_multinomial_rsp.R @@ -146,6 +146,7 @@ a_length_proportion <- make_afun( #' @export estimate_multinomial_response <- function(lyt, var, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -162,7 +163,7 @@ estimate_multinomial_response <- function(lyt, .indent_mods = .indent_mods ) lyt <- split_rows_by(lyt, var = var) - lyt <- summarize_row_groups(lyt) + lyt <- summarize_row_groups(lyt, na_str = na_str) analyze( lyt, @@ -170,6 +171,7 @@ estimate_multinomial_response <- function(lyt, afun = afun, show_labels = show_labels, table_names = table_names, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/estimate_proportion.R b/R/estimate_proportion.R index 7e212811b9..d7d88f1525 100644 --- a/R/estimate_proportion.R +++ b/R/estimate_proportion.R @@ -162,6 +162,7 @@ a_proportion <- make_afun( #' @export estimate_proportion <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -181,6 +182,7 @@ estimate_proportion <- function(lyt, lyt, vars, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = show_labels, diff --git a/R/h_biomarkers_subgroups.R b/R/h_biomarkers_subgroups.R index c873d5693f..69a3079dec 100644 --- a/R/h_biomarkers_subgroups.R +++ b/R/h_biomarkers_subgroups.R @@ -16,6 +16,7 @@ h_tab_one_biomarker <- function(df, afuns, colvars, + na_str = NA_character_, .indent_mods = 0L) { lyt <- basic_table() @@ -32,6 +33,7 @@ h_tab_one_biomarker <- function(df, lyt = lyt, var = "var_label", cfun = afuns, + na_str = na_str, indent_mod = .indent_mods ) @@ -67,7 +69,8 @@ h_tab_one_biomarker <- function(df, lyt <- summarize_row_groups( lyt = lyt, cfun = afuns, - var = "subgroup" + var = "subgroup", + na_str = na_str ) } build_table(lyt, df = df) diff --git a/R/h_map_for_count_abnormal.R b/R/h_map_for_count_abnormal.R index b3cd86fc33..e6d73eb98a 100644 --- a/R/h_map_for_count_abnormal.R +++ b/R/h_map_for_count_abnormal.R @@ -26,7 +26,7 @@ #' variables = list(anl = "ANRIND", split_rows = c("LBCAT", "PARAM")), #' abnormal = list(low = c("LOW"), high = c("HIGH")), #' method = "default", -#' na_level = "" +#' na_str = "" #' ) #' #' df <- data.frame( @@ -58,7 +58,7 @@ #' ), #' abnormal = list(low = c("LOW"), high = c("HIGH")), #' method = "range", -#' na_level = "" +#' na_str = "" #' ) #' #' @export @@ -71,13 +71,19 @@ h_map_for_count_abnormal <- function(df, ), abnormal = list(low = c("LOW", "LOW LOW"), high = c("HIGH", "HIGH HIGH")), method = c("default", "range"), - na_level = "") { + na_level = lifecycle::deprecated(), + na_str = "") { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "h_map_for_count_abnormal(na_level)", "h_map_for_count_abnormal(na_str)") + na_str <- na_level + } + method <- match.arg(method) checkmate::assert_subset(c("anl", "split_rows"), names(variables)) checkmate::assert_false(anyNA(df[variables$split_rows])) assert_df_with_variables(df, variables = list(anl = variables$anl, split_rows = variables$split_rows), - na_level = na_level + na_level = na_str ) assert_df_with_factors(df, list(val = variables$anl)) assert_valid_factor(df[[variables$anl]], any.missing = FALSE) @@ -125,7 +131,7 @@ h_map_for_count_abnormal <- function(df, map_low <- cbind(map_low, low_levels_df) # Define high direction of map - df_high <- subset(df, df[[variables$range_high]] != na_level | !is.na(df[[variables$range_high]])) + df_high <- subset(df, df[[variables$range_high]] != na_str | !is.na(df[[variables$range_high]])) map_high <- unique(df_high[variables$split_rows]) high_levels <- unname(unlist(abnormal[toupper(names(abnormal)) == "HIGH"])) high_levels_df <- as.data.frame(high_levels) diff --git a/R/h_stack_by_baskets.R b/R/h_stack_by_baskets.R index d7c48117cb..b71b5b0aa6 100644 --- a/R/h_stack_by_baskets.R +++ b/R/h_stack_by_baskets.R @@ -4,7 +4,7 @@ #' #' Helper Function to create a new `SMQ` variable in `ADAE` that consists of all adverse events belonging to #' selected Standardized/Customized queries. The new dataset will only contain records of the adverse events -#' belonging to any of the selected baskets. Remember that `na_level` must match the needed pre-processing +#' belonging to any of the selected baskets. Remember that `na_str` must match the needed pre-processing #' done with [df_explicit_na()] to have the desired output. #' #' @inheritParams argument_convention @@ -62,7 +62,13 @@ h_stack_by_baskets <- function(df, smq_varlabel = "Standardized MedDRA Query", keys = c("STUDYID", "USUBJID", "ASTDTM", "AEDECOD", "AESEQ"), aag_summary = NULL, - na_level = "") { + na_level = lifecycle::deprecated(), + na_str = "") { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "h_stack_by_baskets(na_level)", "h_stack_by_baskets(na_str)") + na_str <- na_level + } + smq_nam <- baskets[startsWith(baskets, "SMQ")] # SC corresponding to NAM smq_sc <- gsub(pattern = "NAM", replacement = "SC", x = smq_nam, fixed = TRUE) @@ -76,7 +82,7 @@ h_stack_by_baskets <- function(df, checkmate::assert_subset(baskets, names(df)) checkmate::assert_subset(keys, names(df)) checkmate::assert_subset(smq_sc, names(df)) - checkmate::assert_string(na_level) + checkmate::assert_string(na_str) if (!is.null(aag_summary)) { assert_df_with_variables( @@ -92,8 +98,8 @@ h_stack_by_baskets <- function(df, var_labels <- c(formatters::var_labels(df[, keys]), "SMQ" = smq_varlabel) - # convert `na_level` records from baskets to NA for the later loop and from wide to long steps - df[, c(baskets, smq_sc)][df[, c(baskets, smq_sc)] == na_level] <- NA + # convert `na_str` records from baskets to NA for the later loop and from wide to long steps + df[, c(baskets, smq_sc)][df[, c(baskets, smq_sc)] == na_str] <- NA if (all(is.na(df[, baskets]))) { # in case there is no level for the target baskets df_long <- df[-seq_len(nrow(df)), keys] # we just need an empty dataframe keeping all factor levels @@ -127,7 +133,7 @@ h_stack_by_baskets <- function(df, df_long$SMQ <- as.factor(df_long$SMQ) } - smq_levels <- setdiff(levels(df_long[["SMQ"]]), na_level) + smq_levels <- setdiff(levels(df_long[["SMQ"]]), na_str) if (!is.null(aag_summary)) { # A warning in case there is no match between df and aag_summary records diff --git a/R/imputation_rule.R b/R/imputation_rule.R index 2a87b4ae85..bd28bc337b 100644 --- a/R/imputation_rule.R +++ b/R/imputation_rule.R @@ -14,7 +14,7 @@ #' to an analysis value in category `"BLQ"`, `"LTR"`, `" 1 / 3) { - if (stat != "geom_mean") na_level <- "ND" # 1/3_pre_GT, 1/3_post_GT + if (stat != "geom_mean") na_str <- "ND" # 1/3_pre_GT, 1/3_post_GT if (!post && !stat %in% c("median", "max")) val <- NA # 1/3_pre_GT if (post && !stat %in% c("median", "max", "geom_mean")) val <- NA # 1/3_post_GT } } else if (imp_rule == "1/2") { if (ltr_blq_ratio > 1 / 2 && !stat == "max") { val <- NA # 1/2_GT - na_level <- "ND" # 1/2_GT + na_str <- "ND" # 1/2_GT } } - list(val = val, na_level = na_level) + list(val = val, na_str = na_str) } diff --git a/R/incidence_rate.R b/R/incidence_rate.R index 02a758525b..ddf0410ebc 100644 --- a/R/incidence_rate.R +++ b/R/incidence_rate.R @@ -133,6 +133,7 @@ a_incidence_rate <- make_afun( #' @export estimate_incidence_rate <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -155,6 +156,7 @@ estimate_incidence_rate <- function(lyt, show_labels = show_labels, table_names = table_names, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/kaplan_meier_plot.R b/R/kaplan_meier_plot.R index 3c64c4650a..3ee070afde 100644 --- a/R/kaplan_meier_plot.R +++ b/R/kaplan_meier_plot.R @@ -1217,7 +1217,7 @@ h_grob_median_surv <- function(fit_km, ttheme = gridExtra::ttheme_default()) { data <- h_tbl_median_surv(fit_km, armval = armval) - width <- grid::convertUnit(width, "in") + width <- grid::convertUnit(grid::unit(as.numeric(width), grid::unitType(width)), "in") height <- width * (nrow(data) + 1) / 12 w <- paste(" ", c( @@ -1425,7 +1425,7 @@ h_grob_coxph <- function(..., )) { data <- h_tbl_coxph_pairwise(...) - width <- grid::convertUnit(width, "in") + width <- grid::convertUnit(grid::unit(as.numeric(width), grid::unitType(width)), "in") height <- width * (nrow(data) + 1) / 12 w <- paste(" ", c( diff --git a/R/logistic_regression.R b/R/logistic_regression.R index 8db9c3248a..61b048e7d8 100644 --- a/R/logistic_regression.R +++ b/R/logistic_regression.R @@ -334,7 +334,7 @@ logistic_regression_cols <- function(lyt, #' @return A content function. #' #' @export -logistic_summary_by_flag <- function(flag_var, .indent_mods = NULL) { +logistic_summary_by_flag <- function(flag_var, na_str = NA_character_, .indent_mods = NULL) { checkmate::assert_string(flag_var) function(lyt) { cfun_list <- list( @@ -347,7 +347,8 @@ logistic_summary_by_flag <- function(flag_var, .indent_mods = NULL) { ) summarize_row_groups( lyt = lyt, - cfun = cfun_list + cfun = cfun_list, + na_str = na_str ) } } diff --git a/R/odds_ratio.R b/R/odds_ratio.R index 089861cff6..dac3c1cba7 100644 --- a/R/odds_ratio.R +++ b/R/odds_ratio.R @@ -188,6 +188,7 @@ a_odds_ratio <- make_afun( #' @export estimate_odds_ratio <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -208,6 +209,7 @@ estimate_odds_ratio <- function(lyt, lyt, vars, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = show_labels, diff --git a/R/prop_diff.R b/R/prop_diff.R index 4612b6f00d..27a27c8c06 100644 --- a/R/prop_diff.R +++ b/R/prop_diff.R @@ -191,6 +191,7 @@ a_proportion_diff <- make_afun( #' @export estimate_proportion_diff <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., var_labels = vars, @@ -213,6 +214,7 @@ estimate_proportion_diff <- function(lyt, vars, afun = afun, var_labels = var_labels, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = show_labels, diff --git a/R/prop_diff_test.R b/R/prop_diff_test.R index 80cb1e17a2..c8b65343f9 100644 --- a/R/prop_diff_test.R +++ b/R/prop_diff_test.R @@ -135,6 +135,7 @@ a_test_proportion_diff <- make_afun( #' @export test_proportion_diff <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., var_labels = vars, @@ -156,6 +157,7 @@ test_proportion_diff <- function(lyt, vars, afun = afun, var_labels = var_labels, + na_str = na_str, nested = nested, extra_args = list(...), show_labels = show_labels, diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index d392929469..8af0627940 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -244,6 +244,7 @@ a_ancova <- make_afun( summarize_ancova <- function(lyt, vars, var_labels, + na_str = NA_character_, nested = TRUE, ..., show_labels = "visible", @@ -271,6 +272,7 @@ summarize_ancova <- function(lyt, show_labels = show_labels, table_names = table_names, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/summarize_change.R b/R/summarize_change.R index f23b994179..0c3d66a217 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -120,6 +120,7 @@ a_change_from_baseline <- make_afun( #' @export summarize_change <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -139,6 +140,7 @@ summarize_change <- function(lyt, lyt, vars, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...), table_names = table_names diff --git a/R/summarize_colvars.R b/R/summarize_colvars.R index 7df3304f77..ec1676c7ba 100644 --- a/R/summarize_colvars.R +++ b/R/summarize_colvars.R @@ -62,12 +62,18 @@ #' @export summarize_colvars <- function(lyt, ..., - na_level = NA_character_, + na_level = lifecycle::deprecated(), + na_str = NA_character_, .stats = c("n", "mean_sd", "median", "range", "count_fraction"), .formats = NULL, .labels = NULL, .indent_mods = NULL) { - extra_args <- list(.stats = .stats, na_level = na_level, ...) + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "summarize_colvars(na_level)", "summarize_colvars(na_str)") + na_str <- na_level + } + + extra_args <- list(.stats = .stats, na_str = na_str, ...) if (!is.null(.formats)) extra_args[[".formats"]] <- .formats if (!is.null(.labels)) extra_args[[".labels"]] <- .labels if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods diff --git a/R/summarize_coxreg.R b/R/summarize_coxreg.R index 633d151c04..0e19cdb554 100644 --- a/R/summarize_coxreg.R +++ b/R/summarize_coxreg.R @@ -146,7 +146,7 @@ s_coxreg <- function(model_df, .stats, .which_vars = "all", .var_nms = NULL) { #' #' @param eff (`flag`)\cr whether treatment effect should be calculated. Defaults to `FALSE`. #' @param var_main (`flag`)\cr whether main effects should be calculated. Defaults to `FALSE`. -#' @param na_level (`string`)\cr custom string to replace all `NA` values with. Defaults to `""`. +#' @param na_str (`string`)\cr custom string to replace all `NA` values with. Defaults to `""`. #' @param cache_env (`environment`)\cr an environment object used to cache the regression model in order to #' avoid repeatedly fitting the same model for every row in the table. Defaults to `NULL` (no caching). #' @param varlabels (`list`)\cr a named list corresponds to the names of variables found in data, passed @@ -189,8 +189,14 @@ a_coxreg <- function(df, .stats, .formats, .indent_mods = NULL, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", cache_env = NULL) { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "a_coxreg(na_level)", "a_coxreg(na_str)") + na_str <- na_level + } + cov_no_arm <- !multivar && !"arm" %in% names(variables) && control$interaction # special case: univar no arm cov <- tail(.spl_context$value, 1) # current variable/covariate var_lbl <- formatters::var_labels(df)[cov] # check for df labels @@ -245,7 +251,7 @@ a_coxreg <- function(df, var_names <- if (all(grepl("\\(reference = ", names(var_vals))) && labelstr != tail(.spl_context$value, 1)) { paste(c(labelstr, tail(strsplit(names(var_vals), " ")[[1]], 3)), collapse = " ") # "reference" main effect labels } else if ((!multivar && !eff && !(!var_main && control$interaction) && nchar(labelstr) > 0) || - (multivar && var_main && is.numeric(df[[cov]]))) { + (multivar && var_main && is.numeric(df[[cov]]))) { # nolint labelstr # other main effect labels } else if (multivar && !eff && !var_main && is.numeric(df[[cov]])) { "All" # multivar numeric covariate @@ -255,7 +261,7 @@ a_coxreg <- function(df, in_rows( .list = var_vals, .names = var_names, .labels = var_names, .indent_mods = .indent_mods, .formats = stats::setNames(rep(.formats, length(var_names)), var_names), - .format_na_strs = stats::setNames(rep(na_level, length(var_names)), var_names) + .format_na_strs = stats::setNames(rep(na_str, length(var_names)), var_names) ) } @@ -327,8 +333,14 @@ summarize_coxreg <- function(lyt, ), varlabels = NULL, .indent_mods = NULL, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", .section_div = NA_character_) { + if (lifecycle::is_present(na_level)) { + lifecycle::deprecate_warn("0.9.1", "summarize_coxreg(na_level)", "summarize_coxreg(na_str)") + na_str <- na_level + } + if (multivar && control$interaction) { warning(paste( "Interactions are not available for multivariate cox regression using summarize_coxreg.", @@ -359,7 +371,7 @@ summarize_coxreg <- function(lyt, vars = rep(common_var, length(.stats)), varlabels = stat_labels, extra_args = list( - .stats = .stats, .formats = .formats, .indent_mods = .indent_mods, na_level = rep(na_level, length(.stats)), + .stats = .stats, .formats = .formats, .indent_mods = .indent_mods, na_str = rep(na_str, length(.stats)), cache_env = replicate(length(.stats), list(env)) ) ) @@ -386,6 +398,7 @@ summarize_coxreg <- function(lyt, lyt <- lyt %>% summarize_row_groups( cfun = a_coxreg, + na_str = na_str, extra_args = list( variables = variables, control = control, multivar = multivar, eff = TRUE, var_main = multivar ) @@ -411,6 +424,7 @@ summarize_coxreg <- function(lyt, lyt <- lyt %>% summarize_row_groups( cfun = a_coxreg, + na_str = na_str, extra_args = list( variables = variables, at = at, control = control, multivar = multivar, var_main = if (multivar) multivar else control$interaction @@ -434,7 +448,8 @@ summarize_coxreg <- function(lyt, lyt <- lyt %>% analyze_colvars( afun = a_coxreg, - extra_args = list(variables = variables, at = at, control = control, multivar = multivar, labelstr = "") + extra_args = list(variables = variables, at = at, control = control, multivar = multivar, labelstr = ""), + indent_mod = if (!"arm" %in% names(variables) || multivar) 0L else -1L ) } } diff --git a/R/summarize_glm_count.R b/R/summarize_glm_count.R index b8f6489a61..ca6544e950 100644 --- a/R/summarize_glm_count.R +++ b/R/summarize_glm_count.R @@ -399,6 +399,7 @@ a_glm_count <- make_afun( summarize_glm_count <- function(lyt, vars, var_labels, + na_str = NA_character_, nested = TRUE, ..., show_labels = "visible", @@ -422,6 +423,7 @@ summarize_glm_count <- function(lyt, show_labels = show_labels, table_names = table_names, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/summarize_num_patients.R b/R/summarize_num_patients.R index 8367b5241d..8883eb2f1b 100644 --- a/R/summarize_num_patients.R +++ b/R/summarize_num_patients.R @@ -54,7 +54,9 @@ s_num_patients <- function(x, labelstr, .N_col, count_by = NULL, unique_count_su out <- list( unique = formatters::with_label(c(count1, ifelse(count1 == 0 && .N_col == 0, 0, count1 / .N_col)), labelstr), nonunique = formatters::with_label(count2, labelstr), - unique_count = formatters::with_label(count1, ifelse(unique_count_suffix, paste(labelstr, "(n)"), labelstr)) + unique_count = formatters::with_label( + count1, ifelse(unique_count_suffix, paste0(labelstr, if (nzchar(labelstr)) " ", "(n)"), labelstr) + ) ) out @@ -137,6 +139,7 @@ c_num_patients <- make_afun( #' @export summarize_num_patients <- function(lyt, var, + na_str = NA_character_, .stats = NULL, .formats = NULL, .labels = c( @@ -179,6 +182,7 @@ summarize_num_patients <- function(lyt, lyt = lyt, var = var, cfun = ifelse(isFALSE(riskdiff), cfun, afun_riskdiff), + na_str = na_str, extra_args = extra_args, indent_mod = .indent_mods ) @@ -217,6 +221,7 @@ summarize_num_patients <- function(lyt, #' @export analyze_num_patients <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, .stats = NULL, .formats = NULL, @@ -261,6 +266,7 @@ analyze_num_patients <- function(lyt, afun = ifelse(isFALSE(riskdiff), afun, afun_riskdiff), lyt = lyt, vars = vars, + na_str = na_str, nested = nested, extra_args = extra_args, show_labels = show_labels, diff --git a/R/summarize_patients_exposure_in_cols.R b/R/summarize_patients_exposure_in_cols.R index 390e550064..d83672db3a 100644 --- a/R/summarize_patients_exposure_in_cols.R +++ b/R/summarize_patients_exposure_in_cols.R @@ -176,6 +176,7 @@ a_count_patients_sum_exposure <- function(df, #' @export summarize_patients_exposure_in_cols <- function(lyt, # nolint var, + na_str = NA_character_, ..., .stats = c("n_patients", "sum_exposure"), .labels = c(n_patients = "Patients", sum_exposure = "Person time"), @@ -193,6 +194,7 @@ summarize_patients_exposure_in_cols <- function(lyt, # nolint lyt = lyt, var = var, cfun = a_count_patients_sum_exposure, + na_str = na_str, extra_args = list(...) ) } diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index a06f7ed3b3..bdf9092fe1 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -165,6 +165,7 @@ a_coxph_pairwise <- make_afun( #' @export coxph_pairwise <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., var_labels = "CoxPH", @@ -188,6 +189,7 @@ coxph_pairwise <- function(lyt, show_labels = show_labels, table_names = table_names, afun = afun, + na_str = na_str, nested = nested, extra_args = list(...) ) diff --git a/R/survival_duration_subgroups.R b/R/survival_duration_subgroups.R index 08fc21fa97..4f50bd466c 100644 --- a/R/survival_duration_subgroups.R +++ b/R/survival_duration_subgroups.R @@ -163,7 +163,7 @@ extract_survival_subgroups <- function(variables, #' * `a_survival_subgroups()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @keywords internal -a_survival_subgroups <- function(.formats = list( +a_survival_subgroups <- function(.formats = list( # nolint start n = "xx", n_events = "xx", n_tot_events = "xx", @@ -172,7 +172,7 @@ a_survival_subgroups <- function(.formats = list( hr = list(format_extreme_values(2L)), ci = list(format_extreme_values_ci(2L)), pval = "x.xxxx | (<0.0001)" - )) { + )) { # nolint end checkmate::assert_list(.formats) checkmate::assert_subset( names(.formats), @@ -243,7 +243,8 @@ a_survival_subgroups <- function(.formats = list( tabulate_survival_subgroups <- function(lyt, df, vars = c("n_tot_events", "n_events", "median", "hr", "ci"), - time_unit = NULL) { + time_unit = NULL, + na_str = NA_character_) { conf_level <- df$hr$conf_level[1] method <- df$hr$pval_label[1] @@ -276,7 +277,8 @@ tabulate_survival_subgroups <- function(lyt, lyt_survtime <- summarize_row_groups( lyt = lyt_survtime, var = "var_label", - cfun = afun_lst[names(colvars_survtime$labels)] + cfun = afun_lst[names(colvars_survtime$labels)], + na_str = na_str ) lyt_survtime <- split_cols_by_multivar( lyt = lyt_survtime, @@ -316,7 +318,8 @@ tabulate_survival_subgroups <- function(lyt, lyt_hr <- summarize_row_groups( lyt = lyt_hr, var = "var_label", - cfun = afun_lst[names(colvars_hr$labels)] + cfun = afun_lst[names(colvars_hr$labels)], + na_str = na_str ) lyt_hr <- split_cols_by_multivar( lyt = lyt_hr, diff --git a/R/survival_time.R b/R/survival_time.R index cf5d0b140a..e7d96d1d47 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -123,6 +123,7 @@ a_surv_time <- make_afun( #' @export surv_time <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., var_labels = "Time to Event", @@ -144,6 +145,7 @@ surv_time <- function(lyt, analyze( lyt, vars, + na_str = na_str, nested = nested, var_labels = var_labels, show_labels = "visible", diff --git a/R/survival_timepoint.R b/R/survival_timepoint.R index fcd31d5460..e32fda1113 100644 --- a/R/survival_timepoint.R +++ b/R/survival_timepoint.R @@ -232,6 +232,7 @@ a_surv_timepoint_diff <- make_afun( #' @export surv_timepoint <- function(lyt, vars, + na_str = NA_character_, nested = TRUE, ..., table_names_suffix = "", @@ -290,6 +291,7 @@ surv_timepoint <- function(lyt, table_names = paste0("surv_", tpt, table_names_suffix), show_labels = show_labels, afun = afun_surv, + na_str = na_str, nested = nested, extra_args = list( is_event = list(...)$is_event, @@ -307,6 +309,7 @@ surv_timepoint <- function(lyt, table_names = paste0("surv_diff_", tpt, table_names_suffix), show_labels = ifelse(method == "both", "hidden", show_labels), afun = afun_surv_diff, + na_str = na_str, nested = nested, extra_args = list( is_event = list(...)$is_event, diff --git a/man/abnormal.Rd b/man/abnormal.Rd index c7b3546900..0e50726669 100644 --- a/man/abnormal.Rd +++ b/man/abnormal.Rd @@ -26,6 +26,7 @@ a_count_abnormal( count_abnormal( lyt, var, + na_str = NA_character_, nested = TRUE, ..., table_names = var, @@ -52,6 +53,8 @@ from numerator and denominator.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/abnormal_by_baseline.Rd b/man/abnormal_by_baseline.Rd index 465f939b1d..312721849c 100644 --- a/man/abnormal_by_baseline.Rd +++ b/man/abnormal_by_baseline.Rd @@ -11,7 +11,8 @@ s_count_abnormal_by_baseline( df, .var, abnormal, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", variables = list(id = "USUBJID", baseline = "BNRIND") ) @@ -19,7 +20,8 @@ a_count_abnormal_by_baseline( df, .var, abnormal, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", variables = list(id = "USUBJID", baseline = "BNRIND") ) @@ -27,6 +29,7 @@ count_abnormal_by_baseline( lyt, var, abnormal, + na_str = "", nested = TRUE, ..., table_names = abnormal, @@ -44,7 +47,9 @@ by a statistics function.} \item{abnormal}{(\code{character})\cr identifying the abnormal range level(s) in \code{.var}.} -\item{na_level}{(\code{string})\cr the explicit \code{na_level} argument you used in the pre-processing steps (maybe with +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr the explicit \code{na_level} argument you used in the pre-processing steps (maybe with \code{\link[=df_explicit_na]{df_explicit_na()}}). The default is \code{""}.} \item{variables}{(named \code{list} of \code{string})\cr list of additional analysis variables.} diff --git a/man/abnormal_by_marked.Rd b/man/abnormal_by_marked.Rd index 8ba5cc4761..73a2ca8e54 100644 --- a/man/abnormal_by_marked.Rd +++ b/man/abnormal_by_marked.Rd @@ -26,6 +26,7 @@ a_count_abnormal_by_marked( count_abnormal_by_marked( lyt, var, + na_str = NA_character_, nested = TRUE, ..., .stats = NULL, @@ -50,6 +51,8 @@ and last or replicated.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/abnormal_by_worst_grade.Rd b/man/abnormal_by_worst_grade.Rd index 0bd887a61c..e9afd5d467 100644 --- a/man/abnormal_by_worst_grade.Rd +++ b/man/abnormal_by_worst_grade.Rd @@ -24,6 +24,7 @@ a_count_abnormal_by_worst_grade( count_abnormal_by_worst_grade( lyt, var, + na_str = NA_character_, nested = TRUE, ..., .stats = NULL, @@ -45,6 +46,8 @@ that is passed by \code{rtables}.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/abnormal_by_worst_grade_worsen.Rd b/man/abnormal_by_worst_grade_worsen.Rd index 37109bc510..6e6254c234 100644 --- a/man/abnormal_by_worst_grade_worsen.Rd +++ b/man/abnormal_by_worst_grade_worsen.Rd @@ -22,6 +22,7 @@ a_count_abnormal_lab_worsen_by_baseline( count_abnormal_lab_worsen_by_baseline( lyt, var, + na_str = NA_character_, nested = TRUE, ..., table_names = NULL, @@ -46,6 +47,8 @@ by a statistics function.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/analyze_variables.Rd b/man/analyze_variables.Rd index 5fca62ec7c..29cf623b9c 100644 --- a/man/analyze_variables.Rd +++ b/man/analyze_variables.Rd @@ -68,7 +68,8 @@ a_summary( .labels = NULL, .indent_mods = NULL, na.rm = TRUE, - na_level = NA_character_, + na_level = lifecycle::deprecated(), + na_str = NA_character_, ... ) @@ -76,10 +77,11 @@ analyze_vars( lyt, vars, var_labels = vars, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, ..., na.rm = TRUE, - na_level = NA_character_, show_labels = "default", table_names = vars, section_div = NA_character_, @@ -147,7 +149,9 @@ information on the \code{"auto"} setting.} should be a name-value pair with name corresponding to a statistic specified in \code{.stats} and value the indentation for that statistic's row label.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} @@ -335,7 +339,8 @@ lapply(X, function(x) s_summary(x$x)) ## Basic usage: s_summary(factor(c("a", "a", "b", "c", "a"))) -# Empty factor returns NA-filled items. + +# Empty factor returns zero-filled items. s_summary(factor(levels = c("a", "b", "c"))) ## Management of NA values. @@ -360,6 +365,9 @@ s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na.rm = FALSE, verbose = F ## Basic usage: s_summary(c(TRUE, FALSE, TRUE, TRUE)) +# Empty factor returns zero-filled items. +s_summary(as.logical(c())) + ## Management of NA values. x <- c(NA, TRUE, FALSE) s_summary(x, na.rm = TRUE) diff --git a/man/analyze_vars_in_cols.Rd b/man/analyze_vars_in_cols.Rd index 6a65eaf75a..84ba43ecc8 100644 --- a/man/analyze_vars_in_cols.Rd +++ b/man/analyze_vars_in_cols.Rd @@ -18,8 +18,9 @@ analyze_vars_in_cols( avalcat_var = "AVALCAT1", cache = FALSE, .indent_mods = NULL, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, - na_level = NULL, .formats = NULL, .aligns = NULL ) @@ -65,12 +66,14 @@ used for multiple tables with different data. Defaults to \code{FALSE}.} \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} - \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} diff --git a/man/argument_convention.Rd b/man/argument_convention.Rd index 6b49584632..1e85ca4a90 100644 --- a/man/argument_convention.Rd +++ b/man/argument_convention.Rd @@ -14,8 +14,16 @@ taken from \code{alt_counts_df} if specified (see \code{\link[rtables:build_tabl \item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} +\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more +information on the \code{"auto"} setting.} + \item{.in_ref_col}{(\code{logical})\cr \code{TRUE} when working with the reference level, \code{FALSE} otherwise.} +\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the +unmodified default behavior. Can be negative.} + +\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} + \item{.N_col}{(\code{integer})\cr column-wise N (column count) for the full column being analyzed that is typically passed by \code{rtables}.} @@ -24,22 +32,14 @@ passed by \code{rtables}.} \item{.ref_group}{(\code{data.frame} or \code{vector})\cr the data corresponding to the reference group.} -\item{.stats}{(\code{character})\cr statistics to select for the table.} - -\item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the -unmodified default behavior. Can be negative.} - -\item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more -information on the \code{"auto"} setting.} +\item{.spl_context}{(\code{data.frame})\cr gives information about ancestor split states +that is passed by \code{rtables}.} -\item{.labels}{(named \code{character})\cr labels for the statistics (without indent).} +\item{.stats}{(\code{character})\cr statistics to select for the table.} \item{.var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested by a statistics function.} -\item{.spl_context}{(\code{data.frame})\cr gives information about ancestor split states -that is passed by \code{rtables}.} - \item{add_total_level}{(\code{flag})\cr adds a "total" level after the others which includes all the levels that constitute the split. A custom label can be set for this level via the \code{custom_label} argument.} @@ -79,7 +79,9 @@ two proportions. For options, see \code{\link[=s_test_proportion_diff]{s_test_pr \item{na.rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} diff --git a/man/compare_variables.Rd b/man/compare_variables.Rd index 0f4d0e6ae8..c937b6ceb8 100644 --- a/man/compare_variables.Rd +++ b/man/compare_variables.Rd @@ -45,10 +45,11 @@ compare_vars( lyt, vars, var_labels = vars, + na_level = lifecycle::deprecated(), + na_str = NA_character_, nested = TRUE, ..., na.rm = TRUE, - na_level = NA_character_, show_labels = "default", table_names = vars, section_div = NA_character_, @@ -92,12 +93,14 @@ passed by \code{rtables}.} \item{var_labels}{(\code{character})\cr character for label.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} - \item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} \item{table_names}{(\code{character})\cr this can be customized in case that the same \code{vars} are analyzed multiple times, diff --git a/man/count_cumulative.Rd b/man/count_cumulative.Rd index 51231ca106..f4a986a167 100644 --- a/man/count_cumulative.Rd +++ b/man/count_cumulative.Rd @@ -29,6 +29,7 @@ count_cumulative( vars, var_labels = vars, show_labels = "visible", + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -60,6 +61,8 @@ count, default is \code{TRUE}.} \item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_missed_doses.Rd b/man/count_missed_doses.Rd index f1636a9e0c..a4e02a3963 100644 --- a/man/count_missed_doses.Rd +++ b/man/count_missed_doses.Rd @@ -18,6 +18,7 @@ count_missed_doses( vars, var_labels = vars, show_labels = "visible", + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -43,6 +44,8 @@ passed by \code{rtables}.} \item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_occurrences.Rd b/man/count_occurrences.Rd index f7c5f5d156..78b5bec786 100644 --- a/man/count_occurrences.Rd +++ b/man/count_occurrences.Rd @@ -111,6 +111,8 @@ unmodified default behavior. Can be negative.} used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_occurrences_by_grade.Rd b/man/count_occurrences_by_grade.Rd index a3f6cb0582..3222c09ead 100644 --- a/man/count_occurrences_by_grade.Rd +++ b/man/count_occurrences_by_grade.Rd @@ -33,6 +33,7 @@ count_occurrences_by_grade( var_labels = var, show_labels = "default", riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = var, @@ -45,6 +46,7 @@ count_occurrences_by_grade( summarize_occurrences_by_grade( lyt, var, + na_str = NA_character_, ..., .stats = NULL, .formats = NULL, @@ -82,6 +84,8 @@ for more information.} used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_patients_events_in_cols.Rd b/man/count_patients_events_in_cols.Rd index 40a1ee4bf3..84011b90ce 100644 --- a/man/count_patients_events_in_cols.Rd +++ b/man/count_patients_events_in_cols.Rd @@ -19,6 +19,7 @@ summarize_patients_events_in_cols( lyt, id = "USUBJID", filters_list = list(), + na_str = NA_character_, ..., .stats = c("unique", "all", names(filters_list)), .labels = c(unique = "Patients (All)", all = "Events (All)", @@ -47,6 +48,8 @@ be used as label.} \item{lyt}{(\code{layout})\cr input layout where analyses will be added to.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{...}{additional arguments for the lower level functions.} \item{.stats}{(\code{character})\cr statistics to select for the table.} diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index 3b997eb329..173780583e 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -28,6 +28,7 @@ count_patients_with_event( lyt, vars, riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -69,6 +70,8 @@ passed by \code{rtables}.} used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_patients_with_flags.Rd b/man/count_patients_with_flags.Rd index c3fec138ae..0464e49820 100644 --- a/man/count_patients_with_flags.Rd +++ b/man/count_patients_with_flags.Rd @@ -32,6 +32,7 @@ count_patients_with_flags( var_labels = var, show_labels = "hidden", riskdiff = FALSE, + na_str = NA_character_, nested = TRUE, ..., table_names = paste0("tbl_flags_", var), @@ -76,6 +77,8 @@ by a statistics function.} used as \code{split_fun} in the prior column split of the table layout, specifying which columns should be compared. See \code{\link[=stat_propdiff_ci]{stat_propdiff_ci()}} for details on risk difference calculation.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/count_values_funs.Rd b/man/count_values_funs.Rd index 4637769b6f..33d0d3b0e8 100644 --- a/man/count_values_funs.Rd +++ b/man/count_values_funs.Rd @@ -38,6 +38,7 @@ count_values( lyt, vars, values, + na_str = NA_character_, nested = TRUE, ..., table_names = vars, @@ -73,6 +74,8 @@ passed by \code{rtables}.} \item{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/cox_regression.Rd b/man/cox_regression.Rd index 44274edd38..fe882b50c8 100644 --- a/man/cox_regression.Rd +++ b/man/cox_regression.Rd @@ -22,7 +22,8 @@ a_coxreg( .stats, .formats, .indent_mods = NULL, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", cache_env = NULL ) @@ -38,7 +39,8 @@ summarize_coxreg( "x.xxxx | (<0.0001)", pval_inter = "x.xxxx | (<0.0001)"), varlabels = NULL, .indent_mods = NULL, - na_level = "", + na_level = lifecycle::deprecated(), + na_str = "", .section_div = NA_character_ ) } @@ -94,7 +96,9 @@ information on the \code{"auto"} setting.} \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} -\item{na_level}{(\code{string})\cr custom string to replace all \code{NA} values with. Defaults to \code{""}.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr custom string to replace all \code{NA} values with. Defaults to \code{""}.} \item{cache_env}{(\code{environment})\cr an environment object used to cache the regression model in order to avoid repeatedly fitting the same model for every row in the table. Defaults to \code{NULL} (no caching).} diff --git a/man/estimate_multinomial_rsp.Rd b/man/estimate_multinomial_rsp.Rd index c009dab8c7..b3cff3fb4d 100644 --- a/man/estimate_multinomial_rsp.Rd +++ b/man/estimate_multinomial_rsp.Rd @@ -14,6 +14,7 @@ a_length_proportion(x, .N_col, ...) estimate_multinomial_response( lyt, var, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -37,6 +38,8 @@ passed by \code{rtables}.} \item{var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested by a statistics function.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/estimate_proportions.Rd b/man/estimate_proportions.Rd index 18816068de..7fce15b0ec 100644 --- a/man/estimate_proportions.Rd +++ b/man/estimate_proportions.Rd @@ -34,6 +34,7 @@ a_proportion( estimate_proportion( lyt, vars, + na_str = NA_character_, nested = TRUE, ..., show_labels = "hidden", @@ -76,6 +77,8 @@ to find estimates of optimal weights.} \item{vars}{(\code{character})\cr variable names for the primary analysis variable to be iterated over.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure \emph{if possible} (\code{TRUE}, the default) or as a new top-level element (\code{FALSE}). Ignored if it would nest a split. underneath analyses, which is not allowed.} diff --git a/man/h_map_for_count_abnormal.Rd b/man/h_map_for_count_abnormal.Rd index 5fe4315fe5..332b28c225 100644 --- a/man/h_map_for_count_abnormal.Rd +++ b/man/h_map_for_count_abnormal.Rd @@ -10,7 +10,8 @@ h_map_for_count_abnormal( range_high = "ANRHI"), abnormal = list(low = c("LOW", "LOW LOW"), high = c("HIGH", "HIGH HIGH")), method = c("default", "range"), - na_level = "" + na_level = lifecycle::deprecated(), + na_str = "" ) } \arguments{ @@ -24,7 +25,9 @@ abnormality of the input dataset, it can be something like \code{list(Low = "LOW \item{method}{(\code{string})\cr indicates how the returned map will be constructed. Can be \code{"default"} or \code{"range"}.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} } \value{ A map \code{data.frame}. @@ -49,7 +52,7 @@ h_map_for_count_abnormal( variables = list(anl = "ANRIND", split_rows = c("LBCAT", "PARAM")), abnormal = list(low = c("LOW"), high = c("HIGH")), method = "default", - na_level = "" + na_str = "" ) df <- data.frame( @@ -81,7 +84,7 @@ h_map_for_count_abnormal( ), abnormal = list(low = c("LOW"), high = c("HIGH")), method = "range", - na_level = "" + na_str = "" ) } diff --git a/man/h_stack_by_baskets.Rd b/man/h_stack_by_baskets.Rd index db3858fdb3..818955209a 100644 --- a/man/h_stack_by_baskets.Rd +++ b/man/h_stack_by_baskets.Rd @@ -10,7 +10,8 @@ h_stack_by_baskets( smq_varlabel = "Standardized MedDRA Query", keys = c("STUDYID", "USUBJID", "ASTDTM", "AEDECOD", "AESEQ"), aag_summary = NULL, - na_level = "" + na_level = lifecycle::deprecated(), + na_str = "" ) } \arguments{ @@ -26,7 +27,9 @@ h_stack_by_baskets( variable. This is useful when there are some levels of interest that are not observed in the \code{df} dataset. The two columns of this dataset should be named \code{basket} and \code{basket_name}.} -\item{na_level}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{na_level}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{na_str} argument instead.} + +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} } \value{ \code{data.frame} with variables in \code{keys} taken from \code{df} and new variable \code{SMQ} containing @@ -37,7 +40,7 @@ records belonging to the baskets selected via the \code{baskets} argument. Helper Function to create a new \code{SMQ} variable in \code{ADAE} that consists of all adverse events belonging to selected Standardized/Customized queries. The new dataset will only contain records of the adverse events -belonging to any of the selected baskets. Remember that \code{na_level} must match the needed pre-processing +belonging to any of the selected baskets. Remember that \code{na_str} must match the needed pre-processing done with \code{\link[=df_explicit_na]{df_explicit_na()}} to have the desired output. } \examples{ diff --git a/man/h_tab_one_biomarker.Rd b/man/h_tab_one_biomarker.Rd index 5904c1c6c2..54feaa32e8 100644 --- a/man/h_tab_one_biomarker.Rd +++ b/man/h_tab_one_biomarker.Rd @@ -4,7 +4,13 @@ \alias{h_tab_one_biomarker} \title{Helper Function for Tabulation of a Single Biomarker Result} \usage{ -h_tab_one_biomarker(df, afuns, colvars, .indent_mods = 0L) +h_tab_one_biomarker( + df, + afuns, + colvars, + na_str = NA_character_, + .indent_mods = 0L +) } \arguments{ \item{df}{(\code{data.frame})\cr results for a single biomarker.} @@ -13,6 +19,8 @@ h_tab_one_biomarker(df, afuns, colvars, .indent_mods = 0L) \item{colvars}{(\code{list} with \code{vars} and \code{labels})\cr variables to tabulate and their labels.} +\item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} + \item{.indent_mods}{(named \code{integer})\cr indent modifiers for the labels. Defaults to 0, which corresponds to the unmodified default behavior. Can be negative.} } diff --git a/man/imputation_rule.Rd b/man/imputation_rule.Rd index 73a981c293..c866888421 100644 --- a/man/imputation_rule.Rd +++ b/man/imputation_rule.Rd @@ -32,7 +32,7 @@ to an analysis value in category \code{"BLQ"}, \code{"LTR"}, \code{" + + + + + + + + + + + +A + +c1 +c2 +row 1 +1 +0.8, 1.2 +row 2 +1.2 +1.1, 1.4 + +Hello +World + + + + + + +0.5 +1 +2 + + + + + + + + diff --git a/tests/testthat/_snaps/g_forest/g-forest.svg b/tests/testthat/_snaps/g_forest/g-forest.svg new file mode 100644 index 0000000000..a135fc759e --- /dev/null +++ b/tests/testthat/_snaps/g_forest/g-forest.svg @@ -0,0 +1,113 @@ + + + + + + + + + + + + +Baseline Risk Factors + +A: Drug X + +B: Placebo + + +Total n +n +Response (%) +n +Response (%) +Odds Ratio +95% CI +All Patients +20 +11 +72.7% +9 +77.8% +1.31 +(0.17, 10.26) +Sex + F +11 +6 +100.0% +5 +80.0% +<0.01 +(0.00, >999.99) + M +9 +5 +40.0% +4 +75.0% +4.50 +(0.25, 80.57) +Stratification Factor 2 + S1 +10 +5 +80.0% +5 +80.0% +1.00 +(0.05, 22.18) + S2 +10 +6 +66.7% +4 +75.0% +1.50 +(0.09, 25.39) + +A: Drug X +Better +B: Placebo +Better + + + + + + +0.1 +1 +10 + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/g_km/grob-tmp-char.svg b/tests/testthat/_snaps/g_km/grob-tmp-char.svg new file mode 100644 index 0000000000..cd5290d0dd --- /dev/null +++ b/tests/testthat/_snaps/g_km/grob-tmp-char.svg @@ -0,0 +1,158 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + +Survival Probability + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + + + +Censored + + + + +<=Median +>Median +Patients at Risk: + + +37 +10 +3 +1 +1 +0 +32 +12 +2 +0 +0 +0 + + +<=Median +>Median + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + diff --git a/tests/testthat/_snaps/g_km/grob-tmp-ci.svg b/tests/testthat/_snaps/g_km/grob-tmp-ci.svg new file mode 100644 index 0000000000..2c6110cf33 --- /dev/null +++ b/tests/testthat/_snaps/g_km/grob-tmp-ci.svg @@ -0,0 +1,484 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +N + + + + +69 + + + + +ARM A + + + + +Median + + + + +73 + + + + +ARM B + + + + +95% CI + + + + +58 + + + + +ARM C + + + + +974.6 + + + + +727.8 + + + + +632.3 + + + + +(685.2, 1501) + + + + +(555.8, 1000) + + + + +(391.3, 792.1) + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + +Survival Probability + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + + + + + + + + + +ARM A +ARM B +ARM C + + + +Censored +Patients at Risk: + + + +69 +22 +5 +1 +1 +0 +73 +21 +5 +2 +1 +0 +58 +11 +1 +0 +0 +0 + + + +ARM A +ARM B +ARM C + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + diff --git a/tests/testthat/_snaps/g_km/grob-tmp.svg b/tests/testthat/_snaps/g_km/grob-tmp.svg new file mode 100644 index 0000000000..34f4595df5 --- /dev/null +++ b/tests/testthat/_snaps/g_km/grob-tmp.svg @@ -0,0 +1,478 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +N + + + + +69 + + + + +ARM A + + + + +Median + + + + +73 + + + + +ARM B + + + + +95% CI + + + + +58 + + + + +ARM C + + + + +974.6 + + + + +727.8 + + + + +632.3 + + + + +(685.2, 1501) + + + + +(555.8, 1000) + + + + +(391.3, 792.1) + + +0.00 +0.25 +0.50 +0.75 +1.00 + + + + + +Survival Probability + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + + + + + + +ARM A +ARM B +ARM C + + + +Censored +Patients at Risk: + + + +69 +22 +5 +1 +1 +0 +73 +21 +5 +2 +1 +0 +58 +11 +1 +0 +0 +0 + + + +ARM A +ARM B +ARM C + + + + + + +0 +1000 +2000 +3000 +4000 +5000 +Days + + diff --git a/tests/testthat/_snaps/g_lineplot/g-lineplot-w-stats.svg b/tests/testthat/_snaps/g_lineplot/g-lineplot-w-stats.svg new file mode 100644 index 0000000000..b3fd53ddc7 --- /dev/null +++ b/tests/testthat/_snaps/g_lineplot/g-lineplot-w-stats.svg @@ -0,0 +1,296 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +18 +19 +20 +21 +22 + + + + + + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 +Lab Test ALT (U/L) + +Description of Planned Arm + + + + + + + + + + + + +A: Drug X (N = 69) +B: Placebo (N = 73) +C: Combination (N = 58) +Laboratory Test: ALT (U/L) +Plot of Mean and 80% Confidence Limits by Visit +caption + + + + + + + + + + + + + + + + + + +69 +19.2 +(18.48, 19.90) +69 +20.8 +(20.14, 21.42) +69 +19.6 +(18.90, 20.27) +69 +19.6 +(19.03, 20.23) +69 +20.3 +(19.67, 20.93) +69 +19.8 +(19.16, 20.42) + + + + + + + + + + +73 +20.3 +(19.66, 20.99) +73 +20.2 +(19.54, 20.77) +73 +20.7 +(19.97, 21.34) +73 +19.4 +(18.78, 20.02) +73 +20.4 +(19.71, 21.07) +73 +19.3 +(18.59, 19.93) + + + + + + + + + + +58 +19.2 +(18.49, 19.87) +58 +19.4 +(18.73, 19.99) +58 +20.0 +(19.43, 20.66) +58 +20.3 +(19.68, 20.95) +58 +21.0 +(20.17, 21.76) +58 +19.4 +(18.65, 20.07) + + + + + + + + + + +C: Combination + + + + + + + + + + +B: Placebo + + + + + + + + + + +A: Drug X + + +Mean 95% CI +Mean +n +Mean 95% CI +Mean +n +Mean 95% CI +Mean +n + + diff --git a/tests/testthat/_snaps/g_lineplot/g-lineplot.svg b/tests/testthat/_snaps/g_lineplot/g-lineplot.svg new file mode 100644 index 0000000000..adb9bed9c7 --- /dev/null +++ b/tests/testthat/_snaps/g_lineplot/g-lineplot.svg @@ -0,0 +1,151 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +18 +19 +20 +21 +22 +23 + + + + + + + + + + + + +BASELINE +WEEK 1 DAY 8 +WEEK 2 DAY 15 +WEEK 3 DAY 22 +WEEK 4 DAY 29 +WEEK 5 DAY 36 + +Description of Planned Arm + + + + + + + + + + + + +A: Drug X (N = 69) +B: Placebo (N = 73) +C: Combination (N = 58) +ALT (U/L) +Plot of Mean and 95% Confidence Limits by Visit + + diff --git a/tests/testthat/_snaps/g_step/g-step-custom.svg b/tests/testthat/_snaps/g_step/g-step-custom.svg new file mode 100644 index 0000000000..b3f06ac109 --- /dev/null +++ b/tests/testthat/_snaps/g_step/g-step-custom.svg @@ -0,0 +1,62 @@ + + + + + + + + + + + + + + + + + + + + + + + + + +0.4 +0.6 +0.8 +1.0 + + + + + + + + + + +50 +55 +60 +65 +70 +75 +age +Hazard Ratio + + + +Estimate +g_step_custom + + diff --git a/tests/testthat/_snaps/g_step/g-step.svg b/tests/testthat/_snaps/g_step/g-step.svg new file mode 100644 index 0000000000..8324cf01d1 --- /dev/null +++ b/tests/testthat/_snaps/g_step/g-step.svg @@ -0,0 +1,63 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + +0.5 +1.0 +1.5 +2.0 + + + + + + + +25% +50% +75% +age +Hazard Ratio + + + +CI 95% + + + +Estimate +g_step + + diff --git a/tests/testthat/_snaps/g_waterfall/g-waterfall-decorated.svg b/tests/testthat/_snaps/g_waterfall/g-waterfall-decorated.svg new file mode 100644 index 0000000000..3db6e69047 --- /dev/null +++ b/tests/testthat/_snaps/g_waterfall/g-waterfall-decorated.svg @@ -0,0 +1,81 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 45 + 33 + 30 +-18 +-21 + + +-20 +0 +20 +40 + + + + + + + + + +asdfdsfdsfsd AB12345-BRA-1-id-23 +asdfdsfdsfsd AB12345-BRA-1-id-171 +asdfdsfdsfsd AB12345-BRA-1-id-177 +asdfdsfdsfsd AB12345-BRA-1-id-105 +asdfdsfdsfsd AB12345-BRA-1-id-59 +ID +Percentage Change + +adrs_f$SEX + + +F +Waterfall plot + + diff --git a/tests/testthat/_snaps/g_waterfall/g-waterfall.svg b/tests/testthat/_snaps/g_waterfall/g-waterfall.svg new file mode 100644 index 0000000000..a6a70e6764 --- /dev/null +++ b/tests/testthat/_snaps/g_waterfall/g-waterfall.svg @@ -0,0 +1,64 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 5 + 3 +-1 + + +0 +2 +4 + + + + + + +b +a +c +letters[1:3] +c(3, 5, -1) +g_waterfall + + diff --git a/tests/testthat/_snaps/imputation_rule.md b/tests/testthat/_snaps/imputation_rule.md index 3b05de04c5..5ed736ef27 100644 --- a/tests/testthat/_snaps/imputation_rule.md +++ b/tests/testthat/_snaps/imputation_rule.md @@ -7,7 +7,7 @@ max 92.40745 - $na_level + $na_str [1] "ND" @@ -19,7 +19,7 @@ $val [1] NA - $na_level + $na_str [1] "ND" @@ -32,7 +32,7 @@ geom_mean 40.22144 - $na_level + $na_str [1] "NE" @@ -45,7 +45,7 @@ max 99.26841 - $na_level + $na_str [1] "ND" @@ -58,7 +58,7 @@ max 92.40745 - $na_level + $na_str [1] "NE" @@ -71,7 +71,7 @@ mean 43.38858 - $na_level + $na_str [1] "NE" @@ -84,7 +84,7 @@ geom_mean 40.22144 - $na_level + $na_str [1] "NE" @@ -97,7 +97,7 @@ max 99.26841 - $na_level + $na_str [1] "NE" diff --git a/tests/testthat/_snaps/summarize_coxreg.md b/tests/testthat/_snaps/summarize_coxreg.md index 98b9138061..ec229bd0a6 100644 --- a/tests/testthat/_snaps/summarize_coxreg.md +++ b/tests/testthat/_snaps/summarize_coxreg.md @@ -175,7 +175,7 @@ F 0.67 (0.36, 1.22) M 0.60 (0.36, 0.99) -# summarize_coxreg na_level argument works +# summarize_coxreg `na_str` argument works Code res diff --git a/tests/testthat/_snaps/summarize_num_patients.md b/tests/testthat/_snaps/summarize_num_patients.md index b18211cbfb..fb4b2d2276 100644 --- a/tests/testthat/_snaps/summarize_num_patients.md +++ b/tests/testthat/_snaps/summarize_num_patients.md @@ -16,7 +16,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients works as expected with empty input @@ -37,7 +37,7 @@ $unique_count [1] 0 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients works as expected with unique_count_suffix = FALSE @@ -79,7 +79,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # summarize_num_patients works as expected with healthy input @@ -119,10 +119,10 @@ Code res Output - A B - (N=5) (N=4) - ———————————————————— - (n) 3 3 + A B + (N=5) (N=4) + ——————————————————— + (n) 3 3 # s_num_patients count_by works as expected with healthy input @@ -142,7 +142,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients count_by with missing works as expected with healthy input @@ -163,7 +163,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients count_by with missing case 2 works as expected with healthy input @@ -184,7 +184,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients_content with count_by works as expected with healthy input @@ -205,7 +205,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients_content with count_by case 2 works as expected with healthy input @@ -226,7 +226,7 @@ $unique_count [1] 3 attr(,"label") - [1] " (n)" + [1] "(n)" # s_num_patients_content with count_by trivial cases, identical to without count_by @@ -247,7 +247,7 @@ $unique_count [1] 4 attr(,"label") - [1] " (n)" + [1] "(n)" # summarize_num_patients with count_by works as expected with healthy input @@ -287,10 +287,10 @@ Code res Output - A B - (N=5) (N=4) - ———————————————————— - (n) 3 3 + A B + (N=5) (N=4) + ——————————————————— + (n) 3 3 # summarize_num_patients with count_by different combinations works as expected with healthy input diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 65fd718141..e0f67a376d 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -127,6 +127,13 @@ testthat::test_that("s_summary works with logical vectors", { testthat::expect_snapshot(res) }) +testthat::test_that("s_summary works with length 0 logical vectors", { + result <- s_summary(as.logical(c())) + + res <- testthat::expect_silent(result) + testthat::expect_snapshot(res) +}) + testthat::test_that("s_summary works with logical vectors and by default removes NA", { x <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, NA, NA) @@ -153,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_level = NA_character_ + compare = FALSE, .stats = get_stats("analyze_vars_numeric"), na.rm = TRUE, na_str = NA_character_ ) res_out <- testthat::expect_silent(result) @@ -168,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_level = NA_character_ + na.rm = TRUE, na_str = NA_character_ ) res_out <- testthat::expect_silent(result) @@ -183,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_level = NA_character_, + na.rm = TRUE, na_str = NA_character_, verbose = FALSE ) res_out <- testthat::expect_silent(result) @@ -199,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_level = NA_character_ + na.rm = TRUE, na_str = NA_character_ ) res_out <- testthat::expect_silent(result) @@ -467,7 +474,7 @@ testthat::test_that("`analyze_vars` works with empty named numeric variables", { testthat::expect_snapshot(res) }) -testthat::test_that("analyze_vars 'na_level' argument works as expected", { +testthat::test_that("analyze_vars 'na_str' argument works as expected", { dta <- data.frame( USUBJID = rep(1:6, each = 3), AVISIT = rep(paste0("V", 1:3), 6), @@ -478,7 +485,7 @@ testthat::test_that("analyze_vars 'na_level' argument works as expected", { result <- basic_table() %>% split_cols_by(var = "ARM") %>% split_rows_by(var = "AVISIT") %>% - analyze_vars(vars = "AVAL", na_level = "-") %>% + analyze_vars(vars = "AVAL", na_str = "-") %>% build_table(dta) res <- testthat::expect_silent(result) diff --git a/tests/testthat/test-compare_variables.R b/tests/testthat/test-compare_variables.R index 821e56cd52..81b1936df0 100644 --- a/tests/testthat/test-compare_variables.R +++ b/tests/testthat/test-compare_variables.R @@ -115,10 +115,10 @@ testthat::test_that("compare_vars works with custom settings", { testthat::expect_snapshot(res) }) -testthat::test_that("compare_vars 'na_level' argument works as expected", { +testthat::test_that("compare_vars 'na_str' argument works as expected", { result <- basic_table() %>% split_cols_by("ARMCD", ref_group = "ARM B") %>% - compare_vars("ARM", na_level = "-") %>% + compare_vars("ARM", na_str = "-") %>% build_table(tern_ex_adsl) res <- testthat::expect_silent(result) diff --git a/tests/testthat/test-g_forest.R b/tests/testthat/test-g_forest.R index 3ec4b9dcbe..0da842ce2d 100644 --- a/tests/testthat/test-g_forest.R +++ b/tests/testthat/test-g_forest.R @@ -18,12 +18,8 @@ testthat::test_that("g_forest default plot works", { tbl <- basic_table() %>% tabulate_rsp_subgroups(df) - result <- testthat::expect_silent( - g_forest( - tbl, - draw = FALSE - ) - ) + g_forest <- g_forest(tbl) + vdiffr::expect_doppelganger(title = "g_forest", fig = g_forest) }) testthat::test_that("g_forest works with custom arguments", { @@ -36,7 +32,7 @@ testthat::test_that("g_forest works with custom arguments", { rrow("row 2", 1.2, c(1.1, 1.4)) ) - result <- testthat::expect_silent( + g_forest_custom <- g_forest( tbl = tbl, col_x = 1, @@ -44,8 +40,8 @@ testthat::test_that("g_forest works with custom arguments", { xlim = c(0.5, 2), x_at = c(0.5, 1, 2), vline = 1, - forest_header = c("Hello", "World"), - draw = FALSE + forest_header = c("Hello", "World") ) - ) + + vdiffr::expect_doppelganger(title = "g_forest_custom", fig = g_forest_custom) }) diff --git a/tests/testthat/test-g_km.R b/tests/testthat/test-g_km.R index 90a5ab91d9..50d8c8265a 100644 --- a/tests/testthat/test-g_km.R +++ b/tests/testthat/test-g_km.R @@ -8,11 +8,10 @@ testthat::test_that("g_km default plot works", { grob_tmp <- g_km( df = df, variables = variables, - ci_ribbon = FALSE, - draw = FALSE + ci_ribbon = FALSE ) - testthat::expect_true(grid::is.grob(grob_tmp)) + vdiffr::expect_doppelganger(title = "grob_tmp", fig = grob_tmp) }) testthat::test_that("g_km default plot witch ci_ribbon = TRUE works", { @@ -22,14 +21,13 @@ testthat::test_that("g_km default plot witch ci_ribbon = TRUE works", { variables <- list(tte = "AVAL", is_event = "is_event", arm = "ARMCD") - grob_tmp <- g_km( + grob_tmp_ci <- g_km( df = df, variables = variables, - ci_ribbon = TRUE, - draw = FALSE + ci_ribbon = TRUE ) - testthat::expect_true(grid::is.grob(grob_tmp)) + vdiffr::expect_doppelganger(title = "grob_tmp_ci", fig = grob_tmp_ci) }) testthat::test_that("g_km plot with < = > in group labels works", { @@ -43,14 +41,13 @@ testthat::test_that("g_km plot with < = > in group labels works", { variables <- list(tte = "AVAL", is_event = "is_event", arm = "group") - grob_tmp <- g_km( + grob_tmp_char <- g_km( df = df, variables = variables, - annot_surv_med = FALSE, - draw = FALSE + annot_surv_med = FALSE ) - testthat::expect_true(grid::is.grob(grob_tmp)) + vdiffr::expect_doppelganger(title = "grob_tmp_char", fig = grob_tmp_char) }) testthat::test_that("g_km ylim parameter works as expected", { diff --git a/tests/testthat/test-g_lineplot.R b/tests/testthat/test-g_lineplot.R index ecacc2ef50..8316ffcb44 100644 --- a/tests/testthat/test-g_lineplot.R +++ b/tests/testthat/test-g_lineplot.R @@ -4,11 +4,13 @@ adlb$AVISIT <- droplevels(adlb$AVISIT) adlb <- dplyr::mutate(adlb, AVISIT = forcats::fct_reorder(AVISIT, AVISITN, min)) testthat::test_that("g_lineplot works with default settings", { - testthat::expect_silent(g_lineplot(adlb, adsl)) + g_lineplot <- g_lineplot(adlb, adsl) + + vdiffr::expect_doppelganger(title = "g_lineplot", fig = g_lineplot) }) testthat::test_that("g_lineplot works with custom settings and statistics table", { - testthat::expect_silent(g_lineplot( + g_lineplot_w_stats <- g_lineplot( adlb, adsl, strata = control_lineplot_vars(strata = NULL), @@ -19,5 +21,7 @@ testthat::test_that("g_lineplot works with custom settings and statistics table" y_lab = "Lab Test", subtitle = "Laboratory Test:", caption = "caption" - )) + ) + + vdiffr::expect_doppelganger(title = "g_lineplot_w_stats", fig = g_lineplot_w_stats) }) diff --git a/tests/testthat/test-g_step.R b/tests/testthat/test-g_step.R index 6ce7a4e7b2..03f1cdf44b 100644 --- a/tests/testthat/test-g_step.R +++ b/tests/testthat/test-g_step.R @@ -14,18 +14,18 @@ step_matrix <- fit_survival_step( step_data <- broom::tidy(step_matrix) testthat::test_that("g_step works with default settings", { - gg <- g_step(step_data) - testthat::expect_true(ggplot2::is.ggplot(gg)) + g_step <- g_step(step_data) + vdiffr::expect_doppelganger(title = "g_step", fig = g_step) }) testthat::test_that("g_step works with custom settings", { - gg <- g_step( + g_step_custom <- g_step( step_data, use_percentile = FALSE, est = list(col = "blue", lty = 1), ci_ribbon = NULL ) - testthat::expect_true(ggplot2::is.ggplot(gg)) + vdiffr::expect_doppelganger(title = "g_step_custom", fig = g_step_custom) }) testthat::test_that("tidy.step works as expected for survival STEP results", { diff --git a/tests/testthat/test-g_waterfall.R b/tests/testthat/test-g_waterfall.R index baf9bfbd29..266991c1c2 100644 --- a/tests/testthat/test-g_waterfall.R +++ b/tests/testthat/test-g_waterfall.R @@ -1,27 +1,29 @@ testthat::test_that("g_waterfall default plot works", { - result <- testthat::expect_silent( - g_waterfall( - height = c(3, 5, -1), - id = letters[1:3], - col = NULL - ) + g_waterfall <- g_waterfall( + height = c(3, 5, -1), + id = letters[1:3], + col = NULL ) + vdiffr::expect_doppelganger(title = "g_waterfall", fig = g_waterfall) }) testthat::test_that("g_waterfall plot with labels and colors works", { + set.seed(123) adrs <- tern_ex_adrs adrs_f <- head(dplyr::filter(adrs, PARAMCD == "OVRINV"), 30) adrs_f$pchg <- rnorm(30, 10, 50) adrs_f <- adrs_f[!duplicated(adrs_f$USUBJID), ] - result <- testthat::expect_silent( + g_waterfall_decorated <- g_waterfall( height = adrs_f$pchg, id = paste("asdfdsfdsfsd", adrs_f$USUBJID), col_var = adrs_f$SEX, + col = "blue", xlab = "ID", ylab = "Percentage Change", title = "Waterfall plot" ) - ) + + vdiffr::expect_doppelganger(title = "g_waterfall_decorated", fig = g_waterfall_decorated) }) diff --git a/tests/testthat/test-summarize_coxreg.R b/tests/testthat/test-summarize_coxreg.R index b6c39e10d7..445ea9d427 100644 --- a/tests/testthat/test-summarize_coxreg.R +++ b/tests/testthat/test-summarize_coxreg.R @@ -160,17 +160,28 @@ testthat::test_that("summarize_coxreg 'at' argument works in univariate case", { testthat::expect_snapshot(res) }) -testthat::test_that("summarize_coxreg na_level argument works", { +testthat::test_that("summarize_coxreg `na_str` argument works", { result <- basic_table() %>% summarize_coxreg( variables = variables, control = control_coxreg(interaction = TRUE), - na_level = "---" + na_str = "---" ) %>% build_table(df = dta_bladder) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) + + # deprecation message for `na_level` is correct + suppressWarnings(testthat::expect_warning( + result <- basic_table() %>% + summarize_coxreg( + variables = variables, + control = control_coxreg(interaction = TRUE), + na_level = "---" + ), + "The `na_level` argument" + )) }) testthat::test_that("summarize_coxreg works without treatment arm in univariate case", {