diff --git a/.github/workflows/docs.yaml b/.github/workflows/docs.yaml index 57ae800429..d6c8dde033 100644 --- a/.github/workflows/docs.yaml +++ b/.github/workflows/docs.yaml @@ -40,5 +40,10 @@ jobs: secrets: REPO_GITHUB_TOKEN: ${{ secrets.REPO_GITHUB_TOKEN }} with: + deps-installation-method: setup-r-dependencies + lookup-refs: | + insightsengineering/nestcolor + insightsengineering/formatters + insightsengineering/rtables default-landing-page: latest-tag additional-unit-test-report-directories: unit-test-report-non-cran diff --git a/DESCRIPTION b/DESCRIPTION index 532bed64cc..fad7f9c40a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,7 +25,7 @@ URL: https://insightsengineering.github.io/tern/, BugReports: https://github.com/insightsengineering/tern/issues Depends: R (>= 3.6), - rtables (>= 0.6.8) + rtables (>= 0.6.11) Imports: broom (>= 0.5.4), car (>= 3.0-13), @@ -34,7 +34,7 @@ Imports: dplyr (>= 1.0.0), emmeans (>= 1.10.4), forcats (>= 1.0.0), - formatters (>= 0.5.8), + formatters (>= 0.5.10), ggplot2 (>= 3.5.0), grid, gridExtra (>= 2.0.0), diff --git a/NAMESPACE b/NAMESPACE index a0c4f44e3c..3ff42add0d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -135,6 +135,7 @@ export(get_formats_from_stats) export(get_indents_from_stats) export(get_labels_from_stats) export(get_smooths) +export(get_stat_names) export(get_stats) export(groups_list_to_df) export(h_adlb_abnormal_by_worst_grade) diff --git a/NEWS.md b/NEWS.md index 52a3de5bde..cb8e8d21ae 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,6 +9,11 @@ * Added `as_list` parameter to `g_lineplot()` to allow users to return the line plot and annotation table elements as a list instead of stacked for more complex customization. * Refactored `summarize_change()` to work without `make_afun()` and access all additional function parameter. * Added vignette "Understanding `tern` functions" for future reference. +* Refactored `analyze_vars()` and `a_summary()` to take all options from `?rtables::additional_fun_params`. +* Added to `analyze_vars()` statistical names that are used by `rtables::as_result_df()`. +* Merged `compare_vars()` into `analyze_vars()` as overlap was significant. +* Added the possibility to integrate custom statistical functions to default ones in `analyze_vars()`. +* Reworked `get_labels_from_stats()` to use a named list of levels for each statistic instead of row names. ### Bug Fixes * Fixed bug in `a_summary()` causing non-unique `row_name` values to occur when multiple statistics are selected for count variables. @@ -16,6 +21,7 @@ ### Miscellaneous * Reverted deprecation of quick get functions `summary_formats()` and `summary_labels()`. Added disclaimer about underlying use of `get_stats`. * Corrected handling of extra arguments and `NA` for `summarize_change()`. +* Removed `count_fraction_fixed_dp` exception by assigning it to the result of `count_fraction` with a different format output. # tern 0.9.6 diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 392a253f18..9e7941844e 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -28,6 +28,20 @@ control_analyze_vars <- function(conf_level = 0.95, list(conf_level = conf_level, quantiles = quantiles, quantile_type = quantile_type, test_mean = test_mean) } +# Helper function to fix numeric or counts pval if necessary +.correct_num_or_counts_pval <- function(type, .stats) { + if (type == "numeric") { + if (!is.null(.stats) && any(grepl("^pval", .stats))) { + .stats[grepl("^pval", .stats)] <- "pval" # tmp fix xxx + } + } else { + if (!is.null(.stats) && any(grepl("^pval", .stats))) { + .stats[grepl("^pval", .stats)] <- "pval_counts" # tmp fix xxx + } + } + .stats +} + #' Analyze variables #' #' @description `r lifecycle::badge("stable")` @@ -36,7 +50,7 @@ control_analyze_vars <- function(conf_level = 0.95, #' generic function [s_summary()] to calculate a list of summary statistics. A list of all available statistics for #' numeric variables can be viewed by running `get_stats("analyze_vars_numeric")` and for non-numeric variables by #' running `get_stats("analyze_vars_counts")`. Use the `.stats` parameter to specify the statistics to include in your -#' output summary table. +#' output summary table. Use `compare_with_ref_group = TRUE` to compare the variable with reference groups. #' #' @details #' **Automatic digit formatting:** The number of digits to display can be automatically determined from the analyzed @@ -61,14 +75,7 @@ NULL #' * `s_summary()` returns different statistics depending on the class of `x`. #' #' @export -s_summary <- function(x, - na.rm = TRUE, # nolint - denom, - .N_row, # nolint - .N_col, # nolint - .var, - ...) { - checkmate::assert_flag(na.rm) +s_summary <- function(x, ...) { UseMethod("s_summary", x) } @@ -125,17 +132,17 @@ s_summary <- function(x, #' #' ## Management of NA values. #' x <- c(NA_real_, 1) -#' s_summary(x, na.rm = TRUE) -#' s_summary(x, na.rm = FALSE) +#' s_summary(x, na_rm = TRUE) +#' s_summary(x, na_rm = FALSE) #' #' x <- c(NA_real_, 1, 2) -#' s_summary(x, stats = NULL) +#' s_summary(x) #' #' ## Benefits in `rtables` contructions: #' dta_test <- data.frame( -#' Group = rep(LETTERS[1:3], each = 2), -#' sub_group = rep(letters[1:2], each = 3), -#' x = 1:6 +#' Group = rep(LETTERS[seq(3)], each = 2), +#' sub_group = rep(letters[seq(2)], each = 3), +#' x = seq(6) #' ) #' #' ## The summary obtained in with `rtables`: @@ -150,17 +157,15 @@ s_summary <- function(x, #' lapply(X, function(x) s_summary(x$x)) #' #' @export -s_summary.numeric <- function(x, - na.rm = TRUE, # nolint - denom, - .N_row, # nolint - .N_col, # nolint - .var, - control = control_analyze_vars(), - ...) { +s_summary.numeric <- function(x, control = control_analyze_vars(), ...) { checkmate::assert_numeric(x) + args_list <- list(...) + .N_row <- args_list[[".N_row"]] # nolint + .N_col <- args_list[[".N_col"]] # nolint + na_rm <- args_list[["na_rm"]] %||% TRUE + compare_with_ref_group <- args_list[["compare_with_ref_group"]] - if (na.rm) { + if (na_rm) { x <- x[!is.na(x)] } @@ -244,6 +249,19 @@ s_summary.numeric <- function(x, paste0("Geometric Mean (", f_conf_level(control$conf_level), ")") ) + # Compare with reference group + if (isTRUE(compare_with_ref_group)) { + .ref_group <- args_list[[".ref_group"]] + .in_ref_col <- args_list[[".in_ref_col"]] + checkmate::assert_numeric(.ref_group) + checkmate::assert_flag(.in_ref_col) + + y$pval <- character() + if (!.in_ref_col && n_available(x) > 1 && n_available(.ref_group) > 1) { + y$pval <- stats::t.test(x, .ref_group)$p.value + } + } + y } @@ -260,9 +278,9 @@ s_summary.numeric <- function(x, #' * If `x` is an empty `factor`, a list is still returned for `counts` with one element #' per factor level. If there are no levels in `x`, the function fails. #' * If factor variables contain `NA`, these `NA` values are excluded by default. To include `NA` values -#' set `na.rm = FALSE` and missing values will be displayed as an `NA` level. Alternatively, an explicit +#' set `na_rm = FALSE` and missing values will be displayed as an `NA` level. Alternatively, an explicit #' factor level can be defined for `NA` values during pre-processing via [df_explicit_na()] - the -#' default `na_level` (`""`) will also be excluded when `na.rm` is set to `TRUE`. +#' default `na_level` (`""`) will also be excluded when `na_rm` is set to `TRUE`. #' #' @method s_summary factor #' @@ -278,8 +296,8 @@ s_summary.numeric <- function(x, #' ## Management of NA values. #' x <- factor(c(NA, "Female")) #' x <- explicit_na(x) -#' s_summary(x, na.rm = TRUE) -#' s_summary(x, na.rm = FALSE) +#' s_summary(x, na_rm = TRUE) +#' s_summary(x, na_rm = FALSE) #' #' ## Different denominators. #' x <- factor(c("a", "a", "b", "c", "a")) @@ -287,15 +305,16 @@ s_summary.numeric <- function(x, #' s_summary(x, denom = "N_col", .N_col = 20L) #' #' @export -s_summary.factor <- function(x, - na.rm = TRUE, # nolint - denom = c("n", "N_col", "N_row"), - .N_row, # nolint - .N_col, # nolint - ...) { +s_summary.factor <- function(x, denom = c("n", "N_col", "N_row"), ...) { assert_valid_factor(x) - - if (na.rm) { + args_list <- list(...) + .N_row <- args_list[[".N_row"]] # nolint + .N_col <- args_list[[".N_col"]] # nolint + na_rm <- args_list[["na_rm"]] %||% TRUE + verbose <- args_list[["verbose"]] %||% TRUE + compare_with_ref_group <- args_list[["compare_with_ref_group"]] + + if (na_rm) { x <- x[!is.na(x)] %>% fct_discard("") } else { x <- x %>% explicit_na(label = "NA") @@ -303,9 +322,9 @@ s_summary.factor <- function(x, y <- list() - y$n <- length(x) + y$n <- list("n" = c("n" = length(x))) # all list of a list - y$count <- as.list(table(x, useNA = "ifany")) + y$count <- lapply(as.list(table(x, useNA = "ifany")), setNames, nm = "count") denom <- match.arg(denom) %>% switch( @@ -317,15 +336,45 @@ s_summary.factor <- function(x, y$count_fraction <- lapply( y$count, function(x) { - c(x, ifelse(denom > 0, x / denom, 0)) + c(x, "p" = ifelse(denom > 0, x / denom, 0)) } ) + + y$count_fraction_fixed_dp <- y$count_fraction + y$fraction <- lapply( y$count, - function(count) c("num" = count, "denom" = denom) + function(count) c("num" = unname(count), "denom" = denom) ) - y$n_blq <- sum(grepl("BLQ|LTR|<[1-9]|% fct_discard("") + .ref_group <- .ref_group[!is.na(.ref_group)] %>% fct_discard("") + } else { + x <- x %>% explicit_na(label = "NA") + .ref_group <- .ref_group %>% explicit_na(label = "NA") + } + + if ("NA" %in% levels(x)) levels(.ref_group) <- c(levels(.ref_group), "NA") + checkmate::assert_factor(x, levels = levels(.ref_group), min.levels = 2) + + y$pval_counts <- character() + if (!.in_ref_col && length(x) > 0 && length(.ref_group) > 0) { + tab <- rbind(table(x), table(.ref_group)) + res <- suppressWarnings(stats::chisq.test(tab)) + y$pval_counts <- res$p.value + } + } y } @@ -333,9 +382,6 @@ s_summary.factor <- function(x, #' @describeIn analyze_variables Method for `character` class. This makes an automatic #' conversion to factor (with a warning) and then forwards to the method for factors. #' -#' @param verbose (`flag`)\cr defaults to `TRUE`, which prints out warnings and messages. It is mainly used -#' to print out information about factor casting. -#' #' @note #' * Automatic conversion of character to factor does not guarantee that the table #' can be generated correctly. In particular for sparse tables this very likely can fail. @@ -348,32 +394,22 @@ s_summary.factor <- function(x, #' # `s_summary.character` #' #' ## Basic usage: -#' s_summary(c("a", "a", "b", "c", "a"), .var = "x", verbose = FALSE) -#' s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na.rm = FALSE, verbose = FALSE) +#' s_summary(c("a", "a", "b", "c", "a"), verbose = FALSE) +#' s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na_rm = FALSE, verbose = FALSE) #' #' @export -s_summary.character <- function(x, - na.rm = TRUE, # nolint - denom = c("n", "N_col", "N_row"), - .N_row, # nolint - .N_col, # nolint - .var, - verbose = TRUE, - ...) { - if (na.rm) { +s_summary.character <- function(x, denom = c("n", "N_col", "N_row"), ...) { + args_list <- list(...) + na_rm <- args_list[["na_rm"]] %||% TRUE + verbose <- args_list[["verbose"]] %||% TRUE + + if (na_rm) { y <- as_factor_keep_attributes(x, verbose = verbose) } else { y <- as_factor_keep_attributes(x, verbose = verbose, na_level = "NA") } - s_summary( - x = y, - na.rm = na.rm, - denom = denom, - .N_row = .N_row, - .N_col = .N_col, - ... - ) + s_summary(x = y, denom = denom, ...) } #' @describeIn analyze_variables Method for `logical` class. @@ -398,8 +434,8 @@ s_summary.character <- function(x, #' #' ## Management of NA values. #' x <- c(NA, TRUE, FALSE) -#' s_summary(x, na.rm = TRUE) -#' s_summary(x, na.rm = FALSE) +#' s_summary(x, na_rm = TRUE) +#' s_summary(x, na_rm = FALSE) #' #' ## Different denominators. #' x <- c(TRUE, FALSE, TRUE, TRUE) @@ -407,146 +443,228 @@ s_summary.character <- function(x, #' s_summary(x, denom = "N_col", .N_col = 20L) #' #' @export -s_summary.logical <- function(x, - na.rm = TRUE, # nolint - denom = c("n", "N_col", "N_row"), - .N_row, # nolint - .N_col, # nolint - ...) { - if (na.rm) x <- x[!is.na(x)] +s_summary.logical <- function(x, denom = c("n", "N_col", "N_row"), ...) { + checkmate::assert_logical(x) + args_list <- list(...) + .N_row <- args_list[[".N_row"]] # nolint + .N_col <- args_list[[".N_col"]] # nolint + na_rm <- args_list[["na_rm"]] %||% TRUE + compare_with_ref_group <- args_list[["compare_with_ref_group"]] + + if (na_rm) { + x <- x[!is.na(x)] + } + y <- list() - y$n <- length(x) - count <- sum(x, na.rm = TRUE) + y$n <- c("n" = length(x)) denom <- match.arg(denom) %>% switch( n = length(x), N_row = .N_row, N_col = .N_col ) - y$count <- count - y$count_fraction <- c(count, ifelse(denom > 0, count / denom, 0)) - y$n_blq <- 0L + y$count <- c("count" = sum(x, na.rm = TRUE)) + y$count_fraction <- c(y$count, "fraction" = ifelse(denom > 0, y$count / denom, 0)) + y$count_fraction_fixed_dp <- y$count_fraction + y$fraction <- c("num" = unname(y$count), "denom" = denom) + y$n_blq <- c("n_blq" = 0L) + + + if (isTRUE(compare_with_ref_group)) { + .ref_group <- args_list[[".ref_group"]] + .in_ref_col <- args_list[[".in_ref_col"]] + checkmate::assert_flag(.in_ref_col) + + if (na_rm) { + x <- stats::na.omit(x) + .ref_group <- stats::na.omit(.ref_group) + } else { + x[is.na(x)] <- FALSE + .ref_group[is.na(.ref_group)] <- FALSE + } + + y$pval_counts <- character() + if (!.in_ref_col && length(x) > 0 && length(.ref_group) > 0) { + x <- factor(x, levels = c(TRUE, FALSE)) + .ref_group <- factor(.ref_group, levels = c(TRUE, FALSE)) + tbl <- rbind(table(x), table(.ref_group)) + y$pval_counts <- suppressWarnings(prop_chisq(tbl)) + } + } + y } #' @describeIn analyze_variables Formatted analysis function which is used as `afun` in `analyze_vars()` and #' `compare_vars()` and as `cfun` in `summarize_colvars()`. #' -#' @param compare (`flag`)\cr whether comparison statistics should be analyzed instead of summary statistics -#' (`compare = TRUE` adds `pval` statistic comparing against reference group). +#' @param compare_with_ref_group (`flag`)\cr whether comparison statistics should be analyzed instead of summary +#' statistics (`compare_with_ref_group = TRUE` adds `pval` statistic comparing +#' against reference group). #' #' @return #' * `a_summary()` returns the corresponding list with formatted [rtables::CellValue()]. #' #' @note -#' * To use for comparison (with additional p-value statistic), parameter `compare` must be set to `TRUE`. +#' * To use for comparison (with additional p-value statistic), parameter +#' `compare_with_ref_group` must be set to `TRUE`. #' * Ensure that either all `NA` values are converted to an explicit `NA` level or all `NA` values are left as is. #' #' @examples #' a_summary(factor(c("a", "a", "b", "c", "a")), .N_row = 10, .N_col = 10) #' a_summary( #' factor(c("a", "a", "b", "c", "a")), -#' .ref_group = factor(c("a", "a", "b", "c")), compare = TRUE +#' .ref_group = factor(c("a", "a", "b", "c")), compare_with_ref_group = TRUE, .in_ref_col = TRUE #' ) #' #' a_summary(c("A", "B", "A", "C"), .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE) #' a_summary( #' c("A", "B", "A", "C"), -#' .ref_group = c("B", "A", "C"), .var = "x", compare = TRUE, verbose = FALSE +#' .ref_group = c("B", "A", "C"), .var = "x", compare_with_ref_group = TRUE, verbose = FALSE, +#' .in_ref_col = FALSE #' ) #' #' a_summary(c(TRUE, FALSE, FALSE, TRUE, TRUE), .N_row = 10, .N_col = 10) #' a_summary( #' c(TRUE, FALSE, FALSE, TRUE, TRUE), -#' .ref_group = c(TRUE, FALSE), .in_ref_col = TRUE, compare = TRUE +#' .ref_group = c(TRUE, FALSE), .in_ref_col = TRUE, compare_with_ref_group = TRUE, +#' .in_ref_col = FALSE #' ) #' #' a_summary(rnorm(10), .N_col = 10, .N_row = 20, .var = "bla") -#' a_summary(rnorm(10, 5, 1), .ref_group = rnorm(20, -5, 1), .var = "bla", compare = TRUE) +#' a_summary(rnorm(10, 5, 1), +#' .ref_group = rnorm(20, -5, 1), .var = "bla", compare_with_ref_group = TRUE, +#' .in_ref_col = FALSE +#' ) #' #' @export a_summary <- function(x, - .N_col, # nolint - .N_row, # nolint - .var = NULL, - .df_row = NULL, - .ref_group = NULL, - .in_ref_col = FALSE, - compare = FALSE, + ..., .stats = NULL, + .stat_names_in = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na.rm = TRUE, # nolint - na_str = default_na_str(), - ...) { - extra_args <- list(...) - if (is.numeric(x)) { - type <- "numeric" - if (!is.null(.stats) && any(grepl("^pval", .stats))) { - .stats[grepl("^pval", .stats)] <- "pval" # tmp fix xxx - } - } else { - type <- "counts" - if (!is.null(.stats) && any(grepl("^pval", .stats))) { - .stats[grepl("^pval", .stats)] <- "pval_counts" # tmp fix xxx - } - } + .indent_mods = NULL) { + dots_extra_args <- list(...) + + # Check if there are user-defined functions + default_and_custom_stats_list <- .split_std_from_custom_stats(.stats) + .stats <- default_and_custom_stats_list$default_stats + custom_stat_functions <- default_and_custom_stats_list$custom_stats + + # Correction of the pval indication if it is numeric or counts + type <- ifelse(is.numeric(x), "numeric", "counts") # counts is "categorical" + .stats <- .correct_num_or_counts_pval(type, .stats) + + # Adding automatically extra parameters to the statistic function (see ?rtables::additional_fun_params) + extra_afun_params <- retrieve_extra_afun_params( + names(dots_extra_args$.additional_fun_parameters) + ) + dots_extra_args$.additional_fun_parameters <- NULL # After extraction we do not need them anymore # If one col has NA vals, must add NA row to other cols (using placeholder lvl `fill-na-level`) - if (any(is.na(.df_row[[.var]])) && !any(is.na(x)) && !na.rm) levels(x) <- c(levels(x), "fill-na-level") + if (any(is.na(dots_extra_args$.df_row[[dots_extra_args$.var]])) && !any(is.na(x)) && !dots_extra_args$na_rm) { + levels(x) <- c(levels(x), "fill-na-level") + } - x_stats <- if (!compare) { - s_summary(x = x, .N_col = .N_col, .N_row = .N_row, na.rm = na.rm, ...) - } else { - s_compare( - x = x, .N_col = .N_col, .N_row = .N_row, na.rm = na.rm, .ref_group = .ref_group, .in_ref_col = .in_ref_col, ... + # Check if compare_with_ref_group is TRUE but no ref col is set + if (isTRUE(dots_extra_args$compare_with_ref_group) && + all( + length(dots_extra_args[[".ref_group"]]) == 0, # only used for testing + length(extra_afun_params[[".ref_group"]]) == 0 + ) + ) { + stop( + "For comparison (compare_with_ref_group = TRUE), the reference group must be specified.", + "\nSee split_fun in spit_cols_by()." ) } - # Fill in with formatting defaults if needed + # Main statistical functions application + x_stats <- .apply_stat_functions( + default_stat_fnc = s_summary, + custom_stat_fnc_list = custom_stat_functions, + args_list = c( + x = list(x), + extra_afun_params, + dots_extra_args + ) + ) + + # Fill in with stats defaults if needed met_grp <- paste0(c("analyze_vars", type), collapse = "_") - .stats <- get_stats(met_grp, stats_in = .stats, add_pval = compare) + .stats <- c( + get_stats(met_grp, + stats_in = .stats, + add_pval = dots_extra_args$compare_with_ref_group %||% FALSE + ), + names(custom_stat_functions) # Additional stats from custom functions + ) + + x_stats <- x_stats[.stats] + if (is.character(x) || is.factor(x)) { + levels_per_stats <- lapply(x_stats, names) # if there is a count is table() with levels + } else { + levels_per_stats <- NULL + } + + # Formats checks .formats <- get_formats_from_stats(.stats, .formats) + + # Auto format handling + .formats <- apply_auto_formatting( + .formats, + x_stats, + extra_afun_params$.df_row, + extra_afun_params$.var + ) + + # Indentation checks .indent_mods <- get_indents_from_stats(.stats, .indent_mods) - lbls <- get_labels_from_stats(.stats, .labels) + # Labels assignments + lbls <- get_labels_from_stats(.stats, .labels, levels_per_stats) # Check for custom labels from control_analyze_vars - .labels <- if ("control" %in% names(extra_args)) { - lbls %>% labels_use_control(extra_args[["control"]], .labels) + .labels <- if ("control" %in% names(dots_extra_args)) { + labels_use_control(lbls, dots_extra_args[["control"]], .labels) } else { lbls } - if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] - x_stats <- x_stats[.stats] - - if (is.factor(x) || is.character(x)) { + if (is.character(x) || is.factor(x)) { # Ungroup statistics with values for each level of x - x_ungrp <- ungroup_stats(x_stats, .formats, .labels, .indent_mods) + x_ungrp <- ungroup_stats(x_stats, .formats, .indent_mods) x_stats <- x_ungrp[["x"]] .formats <- x_ungrp[[".formats"]] - .labels <- gsub("fill-na-level", "NA", x_ungrp[[".labels"]]) .indent_mods <- x_ungrp[[".indent_mods"]] + .labels <- .unlist_keep_nulls(.labels) + .labels <- gsub("fill-na-level", "NA", .labels) } - # Auto format handling - .formats <- apply_auto_formatting(.formats, x_stats, .df_row, .var) + # Get and check statistical names from defaults + .stat_names <- get_stat_names(x_stats, .stat_names_in) # note is x_stats in_rows( .list = x_stats, .formats = .formats, .names = names(.labels), + .stat_names = .stat_names, .labels = .labels, - .indent_mods = .indent_mods, - .format_na_strs = na_str + .indent_mods = .indent_mods ) } #' @describeIn analyze_variables Layout-creating function which can take statistics function arguments #' and additional format arguments. This function is a wrapper for [rtables::analyze()]. #' -#' @param ... arguments passed to `s_summary()`. +#' @param ... additional arguments passed to `s_summary()`, including: +#' * `denom`: (`string`) See parameter description below. +#' * `.N_row`: (`numeric(1)`) Row-wise N (row group count) for the group of observations being analyzed (i.e. with no +#' column-based subsetting). +#' * `.N_col`: (`numeric(1)`) Column-wise N (column count) for the full column being tabulated within. +#' * `verbose`: (`flag`) Whether additional warnings and messages should be printed. Mainly used to print out +#' information about factor casting. Defaults to `TRUE`. Used for `character`/`factor` variables only. +#' @param compare_with_ref_group (logical)\cr whether to compare the variable with a reference group. #' @param .indent_mods (named `integer`)\cr indent modifiers for the labels. Each element of the vector #' should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation #' for that statistic's row label. @@ -592,7 +710,7 @@ a_summary <- function(x, #' l <- basic_table() %>% #' split_cols_by(var = "ARM") %>% #' split_rows_by(var = "AVISIT") %>% -#' analyze_vars(vars = "AVAL", na.rm = FALSE) +#' analyze_vars(vars = "AVAL", na_rm = FALSE) #' #' build_table(l, df = dta_test) #' @@ -601,7 +719,7 @@ a_summary <- function(x, #' dta_test <- df_explicit_na(dta_test) #' l <- basic_table() %>% #' split_cols_by(var = "ARM") %>% -#' analyze_vars(vars = "AVISIT", na.rm = FALSE) +#' analyze_vars(vars = "AVISIT", na_rm = FALSE) #' #' build_table(l, df = dta_test) #' @@ -622,29 +740,49 @@ analyze_vars <- function(lyt, var_labels = vars, na_str = default_na_str(), nested = TRUE, - ..., - na.rm = TRUE, # nolint show_labels = "default", table_names = vars, section_div = NA_character_, + ..., + na_rm = TRUE, + compare_with_ref_group = FALSE, .stats = c("n", "mean_sd", "median", "range", "count_fraction"), + .stat_names_in = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL) { - extra_args <- list(.stats = .stats, na.rm = na.rm, na_str = na_str, ...) + # Depending on main functions + extra_args <- list( + "na_rm" = na_rm, + "compare_with_ref_group" = compare_with_ref_group, + ... + ) + + # Needed defaults + if (!is.null(.stats)) extra_args[[".stats"]] <- .stats + if (!is.null(.stat_names_in)) extra_args[[".stat_names_in"]] <- .stat_names_in 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 + + # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params) + extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) + formals(a_summary) <- c( + formals(a_summary), + extra_args[[".additional_fun_parameters"]] + ) + + # Main {rtables} structural call analyze( lyt = lyt, vars = vars, var_labels = var_labels, afun = a_summary, na_str = na_str, + inclNAs = !na_rm, nested = nested, extra_args = extra_args, - inclNAs = TRUE, show_labels = show_labels, table_names = table_names, section_div = section_div diff --git a/R/analyze_vars_in_cols.R b/R/analyze_vars_in_cols.R index 42bfb3ba24..7479c92c83 100644 --- a/R/analyze_vars_in_cols.R +++ b/R/analyze_vars_in_cols.R @@ -232,7 +232,9 @@ analyze_vars_in_cols <- function(lyt, sep = "_" ) if (use_cache) { - if (is.null(cache_env[[var_row_val]])) cache_env[[var_row_val]] <- s_summary(u, ...) + if (is.null(cache_env[[var_row_val]])) { + cache_env[[var_row_val]] <- s_summary(u, ...) + } x_stats <- cache_env[[var_row_val]] } else { x_stats <- s_summary(u, ...) diff --git a/R/argument_convention.R b/R/argument_convention.R index 9e48b22308..5372c41918 100644 --- a/R/argument_convention.R +++ b/R/argument_convention.R @@ -23,6 +23,8 @@ #' @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 .stat_names_in (`character`)\cr names of the statistics that are passed directly to name single statistics +#' (`.stats`). This option is visible when producing [rtables::as_result_df()] with `make_ard = TRUE`. #' @param .var (`string`)\cr single variable name that is passed by `rtables` when requested #' by a statistics function. #' @param add_total_level (`flag`)\cr adds a "total" level after the others which includes all the levels @@ -48,6 +50,7 @@ #' @param method (`string` or `NULL`)\cr specifies the test used to calculate the p-value for the difference between #' two proportions. For options, see [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_rm (`flag`)\cr whether `NA` values should be removed from `x` prior to analysis. #' @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 b84183a53e..ab7c5e9f12 100644 --- a/R/compare_variables.R +++ b/R/compare_variables.R @@ -50,8 +50,6 @@ NULL #' #' @export s_compare <- function(x, - .ref_group, - .in_ref_col, ...) { UseMethod("s_compare", x) } @@ -74,31 +72,13 @@ s_compare <- function(x, #' s_compare(numeric(), .ref_group = numeric(), .in_ref_col = FALSE) #' #' @export -s_compare.numeric <- function(x, - .ref_group, - .in_ref_col, - ...) { - checkmate::assert_numeric(x) - checkmate::assert_numeric(.ref_group) - checkmate::assert_flag(.in_ref_col) - - y <- s_summary.numeric(x = x, ...) - - y$pval <- if (!.in_ref_col && n_available(x) > 1 && n_available(.ref_group) > 1) { - stats::t.test(x, .ref_group)$p.value - } else { - character() - } - - y +s_compare.numeric <- function(x, ...) { + s_summary.numeric(x = x, compare_with_ref_group = TRUE, ...) } #' @describeIn compare_variables Method for `factor` class. This uses the chi-squared test #' to calculate the p-value. #' -#' @param denom (`string`)\cr choice of denominator for factor proportions, -#' can only be `n` (number of values in this row and column intersection). -#' #' @method s_compare factor #' #' @examples @@ -112,56 +92,21 @@ s_compare.numeric <- function(x, #' ## Management of NA values. #' x <- explicit_na(factor(c("a", "a", "b", "c", "a", NA, NA))) #' y <- explicit_na(factor(c("a", "b", "c", NA))) -#' s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na.rm = TRUE) -#' s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na.rm = FALSE) +#' s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na_rm = TRUE) +#' s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na_rm = FALSE) #' #' @export -s_compare.factor <- function(x, - .ref_group, - .in_ref_col, - denom = "n", - na.rm = TRUE, # nolint - ...) { - checkmate::assert_flag(.in_ref_col) - assert_valid_factor(x) - assert_valid_factor(.ref_group) - denom <- match.arg(denom) - - y <- s_summary.factor( +s_compare.factor <- function(x, ...) { + s_summary.factor( x = x, - denom = denom, - na.rm = na.rm, + compare_with_ref_group = TRUE, ... ) - - if (na.rm) { - x <- x[!is.na(x)] %>% fct_discard("") - .ref_group <- .ref_group[!is.na(.ref_group)] %>% fct_discard("") - } else { - x <- x %>% explicit_na(label = "NA") - .ref_group <- .ref_group %>% explicit_na(label = "NA") - } - - if ("NA" %in% levels(x)) levels(.ref_group) <- c(levels(.ref_group), "NA") - checkmate::assert_factor(x, levels = levels(.ref_group), min.levels = 2) - - y$pval_counts <- if (!.in_ref_col && length(x) > 0 && length(.ref_group) > 0) { - tab <- rbind(table(x), table(.ref_group)) - res <- suppressWarnings(stats::chisq.test(tab)) - res$p.value - } else { - character() - } - - y } #' @describeIn compare_variables Method for `character` class. This makes an automatic #' conversion to `factor` (with a warning) and then forwards to the method for factors. #' -#' @param verbose (`flag`)\cr whether warnings and messages should be printed. Mainly used -#' to print out information about factor casting. Defaults to `TRUE`. -#' #' @method s_compare character #' #' @examples @@ -185,22 +130,10 @@ s_compare.factor <- function(x, #' ) #' #' @export -s_compare.character <- function(x, - .ref_group, - .in_ref_col, - denom = "n", - na.rm = TRUE, # nolint - .var, - verbose = TRUE, - ...) { - x <- as_factor_keep_attributes(x, verbose = verbose) - .ref_group <- as_factor_keep_attributes(.ref_group, verbose = verbose) - s_compare( - x = x, - .ref_group = .ref_group, - .in_ref_col = .in_ref_col, - denom = denom, - na.rm = na.rm, +s_compare.character <- function(x, ...) { + s_summary.character( + x, + compare_with_ref_group = TRUE, ... ) } @@ -221,49 +154,29 @@ s_compare.character <- function(x, #' ## Management of NA values. #' x <- c(NA, TRUE, FALSE) #' y <- c(NA, NA, NA, NA, FALSE) -#' s_compare(x, .ref_group = y, .in_ref_col = FALSE, na.rm = TRUE) -#' s_compare(x, .ref_group = y, .in_ref_col = FALSE, na.rm = FALSE) +#' s_compare(x, .ref_group = y, .in_ref_col = FALSE, na_rm = TRUE) +#' s_compare(x, .ref_group = y, .in_ref_col = FALSE, na_rm = FALSE) #' #' @export -s_compare.logical <- function(x, - .ref_group, - .in_ref_col, - na.rm = TRUE, # nolint - denom = "n", - ...) { - denom <- match.arg(denom) - - y <- s_summary.logical( +s_compare.logical <- function(x, ...) { + s_summary.logical( x = x, - na.rm = na.rm, - denom = denom, + compare_with_ref_group = TRUE, ... ) - - if (na.rm) { - x <- stats::na.omit(x) - .ref_group <- stats::na.omit(.ref_group) - } else { - x[is.na(x)] <- FALSE - .ref_group[is.na(.ref_group)] <- FALSE - } - - y$pval_counts <- if (!.in_ref_col && length(x) > 0 && length(.ref_group) > 0) { - x <- factor(x, levels = c(TRUE, FALSE)) - .ref_group <- factor(.ref_group, levels = c(TRUE, FALSE)) - tbl <- rbind(table(x), table(.ref_group)) - suppressWarnings(prop_chisq(tbl)) - } else { - character() - } - - y } #' @describeIn compare_variables Layout-creating function which can take statistics function arguments #' and additional format arguments. This function is a wrapper for [rtables::analyze()]. #' -#' @param ... arguments passed to `s_compare()`. +#' @param ... additional arguments passed to `s_compare()`, including: +#' * `denom`: (`string`) choice of denominator. Options are `c("n", "N_col", "N_row")`. For factor variables, can +#' only be `"n"` (number of values in this row and column intersection). +#' * `.N_row`: (`numeric(1)`) Row-wise N (row group count) for the group of observations being analyzed (i.e. with no +#' column-based subsetting). +#' * `.N_col`: (`numeric(1)`) Column-wise N (column count) for the full column being tabulated within. +#' * `verbose`: (`flag`) Whether additional warnings and messages should be printed. Mainly used to print out +#' information about factor casting. Defaults to `TRUE`. Used for `character`/`factor` variables only. #' @param .indent_mods (named `integer`)\cr indent modifiers for the labels. Each element of the vector #' should be a name-value pair with name corresponding to a statistic specified in `.stats` and value the indentation #' for that statistic's row label. @@ -301,31 +214,31 @@ compare_vars <- function(lyt, na_str = default_na_str(), nested = TRUE, ..., - na.rm = TRUE, # nolint + na_rm = TRUE, show_labels = "default", table_names = vars, section_div = NA_character_, .stats = c("n", "mean_sd", "count_fraction", "pval"), + .stat_names_in = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL) { - 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 - - analyze( + analyze_vars( lyt = lyt, + compare_with_ref_group = TRUE, vars = vars, var_labels = var_labels, - afun = a_summary, na_str = na_str, nested = nested, - extra_args = extra_args, - inclNAs = TRUE, + na_rm = na_rm, show_labels = show_labels, table_names = table_names, - section_div = section_div + section_div = section_div, + .stats = .stats, + .stat_names_in = .stat_names_in, + .formats = .formats, + .labels = .labels, + .indent_mods = .indent_mods, + ... ) } diff --git a/R/count_occurrences.R b/R/count_occurrences.R index 1802eb80a1..d163ff0710 100644 --- a/R/count_occurrences.R +++ b/R/count_occurrences.R @@ -111,19 +111,22 @@ s_count_occurrences <- function(df, ) has_occurrence_per_id <- table(occurrences, ids) > 0 n_ids_per_occurrence <- as.list(rowSums(has_occurrence_per_id)) + cur_count_fraction <- lapply( + n_ids_per_occurrence, + function(i, denom) { + if (i == 0 && denom == 0) { + c(0, 0) + } else { + c(i, i / denom) + } + }, + denom = denom + ) + list( count = n_ids_per_occurrence, - count_fraction = lapply( - n_ids_per_occurrence, - function(i, denom) { - if (i == 0 && denom == 0) { - c(0, 0) - } else { - c(i, i / denom) - } - }, - denom = denom - ), + count_fraction = cur_count_fraction, + count_fraction_fixed_dp = cur_count_fraction, fraction = lapply( n_ids_per_occurrence, function(i, denom) c("num" = i, "denom" = denom), @@ -169,19 +172,17 @@ a_count_occurrences <- function(df, if (is.null(unlist(x_stats))) { return(NULL) } - x_lvls <- names(x_stats[[1]]) # Fill in with formatting defaults if needed .stats <- get_stats("count_occurrences", stats_in = .stats) .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels, row_nms = x_lvls) - .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = x_lvls) + .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels, levels_per_stats = lapply(x_stats, names))) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = names(x_stats[[1]])) - if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] x_stats <- x_stats[.stats] # Ungroup statistics with values for each level of x - x_ungrp <- ungroup_stats(x_stats, .formats, list(), list()) + x_ungrp <- ungroup_stats(x_stats, .formats, list()) x_stats <- x_ungrp[["x"]] .formats <- x_ungrp[[".formats"]] diff --git a/R/count_occurrences_by_grade.R b/R/count_occurrences_by_grade.R index d23001605d..971f8bdadf 100644 --- a/R/count_occurrences_by_grade.R +++ b/R/count_occurrences_by_grade.R @@ -224,7 +224,8 @@ s_count_occurrences_by_grade <- function(df, ) list( - count_fraction = l_count_fraction + count_fraction = l_count_fraction, + count_fraction_fixed_dp = l_count_fraction ) } @@ -270,7 +271,6 @@ a_count_occurrences_by_grade <- function(df, if (is.null(unlist(x_stats))) { return(NULL) } - x_lvls <- names(x_stats[[1]]) # Fill in with formatting defaults if needed .stats <- get_stats("count_occurrences_by_grade", stats_in = .stats) @@ -278,14 +278,13 @@ a_count_occurrences_by_grade <- function(df, .formats <- rep(.formats, length(.stats)) %>% setNames(.stats) } .formats <- get_formats_from_stats(.stats, .formats) - .labels <- get_labels_from_stats(.stats, .labels, row_nms = x_lvls) - .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = x_lvls) + .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels, lapply(x_stats, names))) + .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = names(x_stats[[1]])) - if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] x_stats <- x_stats[.stats] # Ungroup statistics with values for each level of x - x_ungrp <- ungroup_stats(x_stats, .formats, .labels, list()) + x_ungrp <- ungroup_stats(x_stats, .formats, list()) x_stats <- x_ungrp[["x"]] .formats <- x_ungrp[[".formats"]] @@ -295,8 +294,8 @@ a_count_occurrences_by_grade <- function(df, in_rows( .list = x_stats, .formats = .formats, - .names = unlist(.labels), - .labels = unlist(.labels), + .names = .labels, + .labels = .labels, .indent_mods = .indent_mods, .format_na_strs = na_str ) diff --git a/R/count_patients_with_event.R b/R/count_patients_with_event.R index d0ecaa1267..4c22659985 100644 --- a/R/count_patients_with_event.R +++ b/R/count_patients_with_event.R @@ -40,7 +40,7 @@ NULL #' s_count_patients_with_event( #' tern_ex_adae, #' .var = "SUBJID", -#' filters = c("TRTEMFL" = "Y") +#' filters = c("TRTEMFL" = "Y"), #' ) #' #' s_count_patients_with_event( @@ -61,8 +61,8 @@ NULL s_count_patients_with_event <- function(df, .var, filters, - .N_col, # nolint - .N_row, # nolint + .N_col = ncol(df), # nolint + .N_row = nrow(df), # nolint denom = c("n", "N_col", "N_row")) { col_names <- names(filters) filter_values <- filters @@ -105,9 +105,9 @@ s_count_patients_with_event <- function(df, a_count_patients_with_event <- function(df, labelstr = "", filters, - denom = c("n", "N_col", "N_row"), .N_col, # nolint .N_row, # nolint + denom = c("n", "N_col", "N_row"), .df_row, .var = NULL, .stats = NULL, @@ -116,7 +116,7 @@ a_count_patients_with_event <- function(df, .indent_mods = NULL, na_str = default_na_str()) { x_stats <- s_count_patients_with_event( - df = df, .var = .var, filters = filters, .N_col = .N_col, .N_row = .N_row, denom = denom + df = df, .var = .var, filters = filters, .N_col, .N_row, denom = denom ) if (is.null(unlist(x_stats))) { @@ -129,7 +129,6 @@ a_count_patients_with_event <- function(df, .labels <- get_labels_from_stats(.stats, .labels) .indent_mods <- get_indents_from_stats(.stats, .indent_mods) - if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] x_stats <- x_stats[.stats] # Auto format handling @@ -139,7 +138,7 @@ a_count_patients_with_event <- function(df, .list = x_stats, .formats = .formats, .names = names(.labels), - .labels = unlist(.labels), + .labels = .labels, .indent_mods = .indent_mods, .format_na_strs = na_str ) diff --git a/R/count_patients_with_flags.R b/R/count_patients_with_flags.R index 71f6882b23..fd51aa383c 100644 --- a/R/count_patients_with_flags.R +++ b/R/count_patients_with_flags.R @@ -57,8 +57,8 @@ s_count_patients_with_flags <- function(df, .var, flag_variables, flag_labels = NULL, - .N_col, # nolint - .N_row, # nolint + .N_col = ncol(df), # nolint + .N_row = nrow(df), # nolint denom = c("n", "N_col", "N_row")) { checkmate::assert_character(flag_variables) if (!is.null(flag_labels)) { @@ -79,8 +79,8 @@ s_count_patients_with_flags <- function(df, position_satisfy_flags <- Reduce(intersect, tmp) id_satisfy_flags <- as.character(unique(df[position_satisfy_flags, ][[.var]])) s_count_values( - as.character(unique(df[[.var]])), - id_satisfy_flags, + x = as.character(unique(df[[.var]])), + values = id_satisfy_flags, denom = denom, .N_col = .N_col, .N_row = .N_row @@ -88,9 +88,9 @@ s_count_patients_with_flags <- function(df, }) colnames(temp) <- flag_names temp <- data.frame(t(temp)) - result <- temp %>% as.list() + result <- as.list(temp) if (length(flag_variables) == 1) { - for (i in 1:3) names(result[[i]]) <- flag_names[1] + for (i in seq(3)) names(result[[i]]) <- flag_names[1] } result } @@ -116,8 +116,8 @@ a_count_patients_with_flags <- function(df, flag_variables, flag_labels = NULL, denom = c("n", "N_col", "N_row"), - .N_col, # nolint - .N_row, # nolint + .N_col = ncol(df), # nolint + .N_row = nrow(df), # nolint .df_row, .var = NULL, .stats = NULL, @@ -133,43 +133,27 @@ a_count_patients_with_flags <- function(df, if (is.null(unlist(x_stats))) { return(NULL) } - x_lvls <- names(x_stats[[1]]) # Fill in with formatting defaults if needed .stats <- get_stats("count_patients_with_flags", stats_in = .stats) + x_stats <- x_stats[.stats] + .formats <- get_formats_from_stats(.stats, .formats) # label formatting x_nms <- paste(rep(.stats, each = length(flag_variables)), flag_variables, sep = ".") new_lbls <- if (!is.null(.labels)) .labels[names(.labels) %in% x_nms] else NULL - .labels <- get_labels_from_stats(.stats, .labels, row_nms = x_lvls) %>% setNames(x_nms) - if (!is.null(new_lbls)) { - which_lbls <- which(names(new_lbls) %in% names(.labels)) - .labels[which_lbls] <- new_lbls - } + .labels <- .unlist_keep_nulls(get_labels_from_stats(.stats, .labels, + levels_per_stats = lapply(x_stats, names) + )) %>% + setNames(x_nms) # indent mod formatting - indent_stat_def <- if (any(.stats %in% names(.indent_mods))) { - .indent_mods[.stats[.stats %in% names(.indent_mods)]] - } else { - NULL - } .indent_mods <- get_indents_from_stats(.stats, .indent_mods, row_nms = flag_variables) - if (!is.null(names(.indent_mods))) { - .indent_mods <- sapply(names(.indent_mods), function(x) { - if (.indent_mods[x] == 0 && !is.null(length(indent_stat_def))) { - idx <- which(names(indent_stat_def) == gsub("\\..*", "", x)) - if (length(idx) > 0) .indent_mods[[x]] <- indent_stat_def[[idx]] - } - .indent_mods[x] - }) - } - if ("count_fraction_fixed_dp" %in% .stats) x_stats[["count_fraction_fixed_dp"]] <- x_stats[["count_fraction"]] - x_stats <- x_stats[.stats] # Ungroup statistics with values for each level of x - x_ungrp <- ungroup_stats(x_stats, .formats, .labels, list()) + x_ungrp <- ungroup_stats(x_stats, .formats, list()) x_stats <- x_ungrp[["x"]] %>% setNames(x_nms) .formats <- x_ungrp[[".formats"]] %>% setNames(x_nms) @@ -180,7 +164,7 @@ a_count_patients_with_flags <- function(df, .list = x_stats, .formats = .formats, .names = names(.labels), - .labels = unlist(.labels), + .labels = .labels, .indent_mods = .indent_mods, .format_na_strs = na_str ) diff --git a/R/count_values.R b/R/count_values.R index 4f7b475eea..2b71ca2ade 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -36,9 +36,8 @@ NULL s_count_values <- function(x, values, na.rm = TRUE, # nolint - .N_col, # nolint - .N_row, # nolint - denom = c("n", "N_col", "N_row")) { + denom = c("n", "N_col", "N_row"), + ...) { UseMethod("s_count_values", x) } @@ -64,7 +63,7 @@ s_count_values.character <- function(x, is_in_values <- x %in% values - s_summary(is_in_values, ...) + s_summary(is_in_values, na_rm = na.rm, ...) } #' @describeIn count_values Method for `factor` class. This makes an automatic diff --git a/R/riskdiff.R b/R/riskdiff.R index d52f6020a6..0bea490e30 100644 --- a/R/riskdiff.R +++ b/R/riskdiff.R @@ -127,6 +127,7 @@ afun_riskdiff <- function(df, arm_spl_x <- arm_x arm_spl_y <- arm_y } + N_col_x <- .all_col_counts[[arm_spl_x]] # nolint N_col_y <- .all_col_counts[[arm_spl_y]] # nolint cur_var <- tail(.spl_context$cur_col_split[[1]], 1) @@ -140,7 +141,7 @@ afun_riskdiff <- function(df, stat <- ifelse("count_fraction" %in% names(s_x), "count_fraction", "unique") if ("flag_variables" %in% names(s_args)) { var_nms <- s_args$flag_variables - } else if (!is.null(names(s_x[[stat]]))) { + } else if (is.list(s_x[[stat]]) && !is.null(names(s_x[[stat]]))) { var_nms <- names(s_x[[stat]]) } else { var_nms <- "" diff --git a/R/summarize_change.R b/R/summarize_change.R index 832d8647b1..2ad11ad6a4 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -30,7 +30,6 @@ NULL #' #' @keywords internal s_change_from_baseline <- function(df, ...) { - # s_summary should get na.rm args_list <- list(...) .var <- args_list[[".var"]] variables <- args_list[["variables"]] @@ -64,6 +63,8 @@ a_change_from_baseline <- function(df, .formats = NULL, .labels = NULL, .indent_mods = NULL) { + dots_extra_args <- list(...) + # Check if there are user-defined functions default_and_custom_stats_list <- .split_std_from_custom_stats(.stats) .stats <- default_and_custom_stats_list$default_stats @@ -71,15 +72,18 @@ a_change_from_baseline <- function(df, # Adding automatically extra parameters to the statistic function (see ?rtables::additional_fun_params) extra_afun_params <- retrieve_extra_afun_params( - names(list(...)$.additional_fun_parameters) + names(dots_extra_args$.additional_fun_parameters) ) + dots_extra_args$.additional_fun_parameters <- NULL # After extraction we do not need them anymore + + # Main stats calculations x_stats <- .apply_stat_functions( default_stat_fnc = s_change_from_baseline, custom_stat_fnc_list = custom_stat_functions, args_list = c( df = list(df), extra_afun_params, - list(...) + dots_extra_args ) ) @@ -184,7 +188,7 @@ summarize_change <- function(lyt, if (!is.null(.indent_mods)) extra_args[[".indent_mods"]] <- .indent_mods # Adding additional arguments to the analysis function (depends on the specific call) - extra_args <- c(extra_args, "variables" = list(variables), ...) + extra_args <- c(extra_args, "na_rm" = na_rm, "variables" = list(variables), ...) # Adding all additional information from layout to analysis functions (see ?rtables::additional_fun_params) extra_args[[".additional_fun_parameters"]] <- get_additional_afun_params(add_alt_df = FALSE) @@ -202,7 +206,7 @@ summarize_change <- function(lyt, na_str = na_str, nested = nested, extra_args = extra_args, - inclNAs = na_rm, # adds na.rm = TRUE to the analysis function + inclNAs = na_rm, show_labels = show_labels, table_names = table_names, section_div = section_div diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 64a041b715..02cf477422 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -59,15 +59,15 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a method_groups[method_groups == "analyze_vars"] <- "analyze_vars_numeric" } - type_tmp <- ifelse(any(grepl("counts", method_groups)), "counts", "numeric") # for pval checks + type_tmp <- ifelse(any(grepl("counts$", method_groups)), "counts", "numeric") # for pval checks # Defaults for loop out <- NULL # Loop for multiple method groups for (mgi in method_groups) { - out_tmp <- if (mgi %in% names(tern_default_stats)) { - tern_default_stats[[mgi]] + if (mgi %in% names(tern_default_stats)) { + out_tmp <- tern_default_stats[[mgi]] } else { stop("The selected method group (", mgi, ") has no default statistical method.") } @@ -121,6 +121,48 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a out } + +#' @describeIn default_stats_formats_labels Get statistical NAMES available for a given method +#' group (analyze function). Please use the `s_*` functions to get the statistical names. +#' @param stat_results (`list`)\cr list of statistical results. It should be used close to the end of +#' a statistical function. See examples for a structure with two statistical results and two groups. +#' @param stat_names_in (`character`)\cr custom modification of statistical values. +#' +#' @return +#' * `get_stat_names()` returns a named list of`character` vectors, indicating the names of +#' statistical outputs. +#' +#' @examples +#' stat_results <- list( +#' "n" = list("M" = 1, "F" = 2), +#' "count_fraction" = list("M" = c(1, 0.2), "F" = c(2, 0.1)) +#' ) +#' get_stat_names(stat_results) +#' get_stat_names(stat_results, list("n" = "argh")) +#' +#' @export +get_stat_names <- function(stat_results, stat_names_in = NULL) { + checkmate::assert_character(names(stat_results), min.len = 1) + checkmate::assert_list(stat_names_in, null.ok = TRUE) + + stat_nms_from_stats <- lapply(stat_results, function(si) { + nm <- names(si) + if (is.null(nm)) { + nm <- rep(NA_character_, length(si)) # no statistical names + } + return(nm) + }) + + # Modify some with custom stat names + if (!is.null(stat_names_in)) { + # Stats is the main + common_names <- intersect(names(stat_nms_from_stats), names(stat_names_in)) + stat_nms_from_stats[common_names] <- stat_names_in[common_names] + } + + stat_nms_from_stats +} + # Utility function used to separate custom stats (user-defined functions) from defaults .split_std_from_custom_stats <- function(stats_in) { out <- list(default_stats = NULL, custom_stats = NULL) @@ -234,11 +276,12 @@ get_formats_from_stats <- function(stats, formats_in = NULL) { #' the statistics name will be used as label. #' #' @param labels_in (named `character`)\cr inserted labels to replace defaults. -#' @param row_nms (`character`)\cr row names. Levels of a `factor` or `character` variable, each +#' @param levels_per_stats (named `list` of `character` or `NULL`)\cr Levels of a `factor` or `character` variable, each #' of which the statistics in `.stats` will be calculated for. If this parameter is set, these #' variable levels will be used as the defaults, and the names of the given custom values should #' correspond to levels (or have format `statistic.level`) instead of statistics. Can also be #' variable names if rows correspond to different variables instead of levels. Defaults to `NULL`. +#' @param row_nms (`character`)\cr See `levels_per_stats`. Deprecation cycle started. #' #' @return #' * `get_labels_from_stats()` returns a named `character` vector of labels (if present in either @@ -256,9 +299,9 @@ get_formats_from_stats <- function(stats, formats_in = NULL) { #' get_labels_from_stats(all_cnt_occ, labels_in = list("fraction" = c("Some more fractions"))) #' #' @export -get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL) { +get_labels_from_stats <- function(stats, labels_in = NULL, levels_per_stats = NULL) { checkmate::assert_character(stats, min.len = 1) - checkmate::assert_character(row_nms, null.ok = TRUE) + checkmate::assert_list(levels_per_stats, null.ok = TRUE) # It may be a list if (checkmate::test_list(labels_in, null.ok = TRUE)) { checkmate::assert_list(labels_in, null.ok = TRUE) @@ -267,14 +310,10 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL) { checkmate::assert_character(labels_in, null.ok = TRUE) } - if (!is.null(row_nms)) { - ret <- rep(row_nms, length(stats)) - out <- setNames(ret, paste(rep(stats, each = length(row_nms)), ret, sep = ".")) - - if (!is.null(labels_in)) { - lvl_lbls <- intersect(names(labels_in), row_nms) - for (i in lvl_lbls) out[paste(stats, i, sep = ".")] <- labels_in[[i]] - } + # Default for stats with sublevels (for factors or chrs) are the labels + if (!is.null(levels_per_stats)) { + out <- .adjust_stats_desc_by_in_def(levels_per_stats, labels_in, tern_default_labels) + # numeric case, where there are not other levels (list of stats) } else { which_lbl <- match(stats, names(tern_default_labels)) @@ -282,13 +321,13 @@ get_labels_from_stats <- function(stats, labels_in = NULL, row_nms = NULL) { ret[!is.na(which_lbl)] <- tern_default_labels[which_lbl[!is.na(which_lbl)]] out <- setNames(ret, stats) - } - # Modify some with custom labels - if (!is.null(labels_in)) { - # Stats is the main - common_names <- intersect(names(out), names(labels_in)) - out[common_names] <- labels_in[common_names] + # Modify some with custom labels + if (!is.null(labels_in)) { + # Stats is the main + common_names <- intersect(names(out), names(labels_in)) + out[common_names] <- unlist(labels_in[common_names], recursive = FALSE) + } } out @@ -351,6 +390,72 @@ get_indents_from_stats <- function(stats, indents_in = NULL, row_nms = NULL) { out } +# Function to loop over each stat and levels to set correct values +.adjust_stats_desc_by_in_def <- function(levels_per_stats, user_in, tern_defaults) { + out <- levels_per_stats + + # Seq over the stats levels (can be also flat (stat$NULL)) + for (stat_i in seq_along(levels_per_stats)) { + # If you want to change all factor levels at once by statistic + common_stat_names <- intersect(names(levels_per_stats), names(user_in)) + + # Levels for each statistic + nm_of_levs <- levels_per_stats[[stat_i]] + # Special case in which only stat$NULL + if (is.null(nm_of_levs)) { + nm_of_levs <- "a single NULL level" + } + + # Loop over levels for each statistic + for (lev_i in seq_along(nm_of_levs)) { + # If there are no further names (stat$NULL) push label (stat) down to lowest level + if (is.null(levels_per_stats[[stat_i]])) { + lev_val <- names(levels_per_stats[stat_i]) + out[[stat_i]] <- lev_val + } else { + lev_val <- levels_per_stats[[stat_i]][[lev_i]] + } + + # Add default if it is a stat at last level + if (lev_val %in% names(tern_defaults)) { + out[[stat_i]][[lev_i]] <- tern_defaults[[lev_val]] + } + + # If a general stat was added to the custom labels + if (names(levels_per_stats[stat_i]) %in% names(user_in)) { + out[[stat_i]][[lev_i]] <- user_in[[names(levels_per_stats[stat_i])]] + } + + # If a stat level (e.g. if it is counts levels from table) was added to the custom labels + if (lev_val %in% names(user_in)) { + out[[stat_i]][[lev_i]] <- user_in[[lev_val]] + } + + # If stat_i.lev_val is added to labels_in + composite_stat_lev_nm <- paste( + names(levels_per_stats[stat_i]), + lev_val, + sep = "." + ) + if (composite_stat_lev_nm %in% names(user_in)) { + out[[stat_i]][[lev_i]] <- user_in[[composite_stat_lev_nm]] + } + + # Used by the unlist (to avoid count_fraction1, count_fraction2, etc.) + names(out[[stat_i]])[lev_i] <- lev_val + } + } + + out +} + +# Custom unlist function to retain NULL as "NULL" or NA +.unlist_keep_nulls <- function(lst, null_placeholder = "NULL", recursive = FALSE) { + lapply(lst, function(x) if (is.null(x)) null_placeholder else x) %>% + unlist(recursive = recursive) +} + + #' Update labels according to control specifications #' #' @description `r lifecycle::badge("stable")` @@ -419,6 +524,7 @@ labels_use_control <- function(labels_default, control, labels_custom = NULL) { labels_default } +# tern_default_stats ----------------------------------------------------------- #' @describeIn default_stats_formats_labels Named list of available statistics by method group for `tern`. #' #' @format @@ -474,6 +580,7 @@ tern_default_stats <- list( test_proportion_diff = c("pval") ) +# tern_default_formats --------------------------------------------------------- #' @describeIn default_stats_formats_labels Named vector of default formats for `tern`. #' #' @format @@ -529,6 +636,7 @@ tern_default_formats <- c( rate_ratio_ci = "(xx.xxxx, xx.xxxx)" ) +# tern_default_labels ---------------------------------------------------------- #' @describeIn default_stats_formats_labels Named `character` vector of default labels for `tern`. #' #' @format @@ -543,7 +651,7 @@ tern_default_labels <- c( n = "n", count = "count", count_fraction = "count_fraction", - count_fraction_fixed_dp = "count_fraction", + count_fraction_fixed_dp = "count_fraction_fixed_dp", n_blq = "n_blq", sum = "Sum", mean = "Mean", diff --git a/R/utils_factor.R b/R/utils_factor.R index dd7680690d..1c04847549 100644 --- a/R/utils_factor.R +++ b/R/utils_factor.R @@ -282,42 +282,38 @@ fct_collapse_only <- function(.f, ..., .na_level = "") { #' Ungroups grouped non-numeric statistics within input vectors `.formats`, `.labels`, and `.indent_mods`. #' #' @inheritParams argument_convention -#' @param x (named `list` of `numeric`)\cr list of numeric statistics containing the statistics to ungroup. +#' @param stat_out (named `list` of `numeric`)\cr list of numeric statistics containing the statistics to ungroup. #' -#' @return A `list` with modified elements `x`, `.formats`, `.labels`, and `.indent_mods`. +#' @return A `list` with modified elements `stat_out`, `.formats`, `.labels`, `.levels`, and `.indent_mods`. #' #' @seealso [a_summary()] which uses this function internally. #' #' @keywords internal -ungroup_stats <- function(x, +ungroup_stats <- function(stat_out, .formats, - .labels, .indent_mods) { - checkmate::assert_list(x) - empty_pval <- "pval" %in% names(x) && length(x[["pval"]]) == 0 - empty_pval_counts <- "pval_counts" %in% names(x) && length(x[["pval_counts"]]) == 0 - x <- unlist(x, recursive = FALSE) + checkmate::assert_list(stat_out) + empty_pval <- "pval" %in% names(stat_out) && length(stat_out[["pval"]]) == 0 + empty_pval_counts <- "pval_counts" %in% names(stat_out) && length(stat_out[["pval_counts"]]) == 0 + stat_out <- unlist(stat_out, recursive = FALSE) # If p-value is empty it is removed by unlist and needs to be re-added - if (empty_pval) x[["pval"]] <- character() - if (empty_pval_counts) x[["pval_counts"]] <- character() - .stats <- names(x) + if (empty_pval) stat_out[["pval"]] <- character() + if (empty_pval_counts) stat_out[["pval_counts"]] <- character() + .stats <- sapply(regmatches(names(stat_out), regexpr("\\.", names(stat_out)), invert = TRUE), function(xi) xi[[1]]) # Ungroup stats .formats <- lapply(.stats, function(x) { .formats[[if (!grepl("\\.", x)) x else regmatches(x, regexpr("\\.", x), invert = TRUE)[[1]][1]]] }) + .indent_mods <- sapply(.stats, function(x) { .indent_mods[[if (!grepl("\\.", x)) x else regmatches(x, regexpr("\\.", x), invert = TRUE)[[1]][1]]] }) - .labels <- sapply(.stats, function(x) { - if (!grepl("\\.", x)) .labels[[x]] else regmatches(x, regexpr("\\.", x), invert = TRUE)[[1]][2] - }) list( - x = x, + x = stat_out, .formats = .formats, - .labels = .labels, .indent_mods = .indent_mods ) } diff --git a/man/analyze_variables.Rd b/man/analyze_variables.Rd index ba567bd1ae..4b453d4d68 100644 --- a/man/analyze_variables.Rd +++ b/man/analyze_variables.Rd @@ -17,75 +17,37 @@ analyze_vars( var_labels = vars, na_str = default_na_str(), nested = TRUE, - ..., - na.rm = TRUE, show_labels = "default", table_names = vars, section_div = NA_character_, + ..., + na_rm = TRUE, + compare_with_ref_group = FALSE, .stats = c("n", "mean_sd", "median", "range", "count_fraction"), + .stat_names_in = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL ) -s_summary(x, na.rm = TRUE, denom, .N_row, .N_col, .var, ...) +s_summary(x, ...) -\method{s_summary}{numeric}( - x, - na.rm = TRUE, - denom, - .N_row, - .N_col, - .var, - control = control_analyze_vars(), - ... -) +\method{s_summary}{numeric}(x, control = control_analyze_vars(), ...) -\method{s_summary}{factor}( - x, - na.rm = TRUE, - denom = c("n", "N_col", "N_row"), - .N_row, - .N_col, - ... -) +\method{s_summary}{factor}(x, denom = c("n", "N_col", "N_row"), ...) -\method{s_summary}{character}( - x, - na.rm = TRUE, - denom = c("n", "N_col", "N_row"), - .N_row, - .N_col, - .var, - verbose = TRUE, - ... -) +\method{s_summary}{character}(x, denom = c("n", "N_col", "N_row"), ...) -\method{s_summary}{logical}( - x, - na.rm = TRUE, - denom = c("n", "N_col", "N_row"), - .N_row, - .N_col, - ... -) +\method{s_summary}{logical}(x, denom = c("n", "N_col", "N_row"), ...) a_summary( x, - .N_col, - .N_row, - .var = NULL, - .df_row = NULL, - .ref_group = NULL, - .in_ref_col = FALSE, - compare = FALSE, + ..., .stats = NULL, + .stat_names_in = NULL, .formats = NULL, .labels = NULL, - .indent_mods = NULL, - na.rm = TRUE, - na_str = default_na_str(), - ... + .indent_mods = NULL ) } \arguments{ @@ -101,10 +63,6 @@ a_summary( 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{...}{arguments passed to \code{s_summary()}.} - -\item{na.rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} - \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 the case that the same \code{vars} are analyzed multiple @@ -113,12 +71,31 @@ times, to avoid warnings from \code{rtables}.} \item{section_div}{(\code{string})\cr string which should be repeated as a section divider after each group defined by this split instruction, or \code{NA_character_} (the default) for no section divider.} +\item{...}{additional arguments passed to \code{s_summary()}, including: +\itemize{ +\item \code{denom}: (\code{string}) See parameter description below. +\item \code{.N_row}: (\code{numeric(1)}) Row-wise N (row group count) for the group of observations being analyzed (i.e. with no +column-based subsetting). +\item \code{.N_col}: (\code{numeric(1)}) Column-wise N (column count) for the full column being tabulated within. +\item \code{verbose}: (\code{flag}) Whether additional warnings and messages should be printed. Mainly used to print out +information about factor casting. Defaults to \code{TRUE}. Used for \code{character}/\code{factor} variables only. +}} + +\item{na_rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} + +\item{compare_with_ref_group}{(\code{flag})\cr whether comparison statistics should be analyzed instead of summary +statistics (\code{compare_with_ref_group = TRUE} adds \code{pval} statistic comparing +against reference group).} + \item{.stats}{(\code{character})\cr statistics to select for the table. Options for numeric variables are: \verb{'n', 'sum', 'mean', 'sd', 'se', 'mean_sd', 'mean_se', 'mean_ci', 'mean_sei', 'mean_sdi', 'mean_pval', 'median', 'mad', 'median_ci', 'quantiles', 'iqr', 'range', 'min', 'max', 'median_range', 'cv', 'geom_mean', 'geom_mean_ci', 'geom_cv', 'median_ci_3d', 'mean_ci_3d', 'geom_mean_ci_3d'} Options for non-numeric variables are: \verb{'n', 'count', 'count_fraction', 'count_fraction_fixed_dp', 'fraction', 'n_blq'}} +\item{.stat_names_in}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \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.} @@ -130,22 +107,6 @@ for that statistic's row label.} \item{x}{(\code{numeric})\cr vector of numbers we want to analyze.} -\item{denom}{(\code{string})\cr choice of denominator for proportion. Options are: -\itemize{ -\item \code{n}: number of values in this row and column intersection. -\item \code{N_row}: total number of values in this row across columns. -\item \code{N_col}: total number of values in this column across rows. -}} - -\item{.N_row}{(\code{integer(1)})\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 \code{rtables}.} - -\item{.N_col}{(\code{integer(1)})\cr column-wise N (column count) for the full column being analyzed that is typically -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{control}{(\code{list})\cr parameters for descriptive statistics details, specified by using the helper function \code{\link[=control_analyze_vars]{control_analyze_vars()}}. Some possible parameter options are: \itemize{ @@ -156,17 +117,12 @@ See more about \code{type} in \code{\link[stats:quantile]{stats::quantile()}}. \item \code{test_mean} (\code{numeric(1)})\cr value to test against the mean under the null hypothesis when calculating p-value. }} -\item{verbose}{(\code{flag})\cr defaults to \code{TRUE}, which prints out warnings and messages. It is mainly used -to print out information about factor casting.} - -\item{.df_row}{(\code{data.frame})\cr data frame across all of the columns for the given row split.} - -\item{.ref_group}{(\code{data.frame} or \code{vector})\cr the data corresponding to the reference group.} - -\item{.in_ref_col}{(\code{flag})\cr \code{TRUE} when working with the reference level, \code{FALSE} otherwise.} - -\item{compare}{(\code{flag})\cr whether comparison statistics should be analyzed instead of summary statistics -(\code{compare = TRUE} adds \code{pval} statistic comparing against reference group).} +\item{denom}{(\code{string})\cr choice of denominator for proportion. Options are: +\itemize{ +\item \code{n}: number of values in this row and column intersection. +\item \code{N_row}: total number of values in this row across columns. +\item \code{N_col}: total number of values in this column across rows. +}} } \value{ \itemize{ @@ -240,7 +196,7 @@ The analyze function \code{\link[=analyze_vars]{analyze_vars()}} creates a layou generic function \code{\link[=s_summary]{s_summary()}} to calculate a list of summary statistics. A list of all available statistics for numeric variables can be viewed by running \code{get_stats("analyze_vars_numeric")} and for non-numeric variables by running \code{get_stats("analyze_vars_counts")}. Use the \code{.stats} parameter to specify the statistics to include in your -output summary table. +output summary table. Use \code{compare_with_ref_group = TRUE} to compare the variable with reference groups. } \details{ \strong{Automatic digit formatting:} The number of digits to display can be automatically determined from the analyzed @@ -280,9 +236,9 @@ being standard behavior in R. \item If \code{x} is an empty \code{factor}, a list is still returned for \code{counts} with one element per factor level. If there are no levels in \code{x}, the function fails. \item If factor variables contain \code{NA}, these \code{NA} values are excluded by default. To include \code{NA} values -set \code{na.rm = FALSE} and missing values will be displayed as an \code{NA} level. Alternatively, an explicit +set \code{na_rm = FALSE} and missing values will be displayed as an \code{NA} level. Alternatively, an explicit factor level can be defined for \code{NA} values during pre-processing via \code{\link[=df_explicit_na]{df_explicit_na()}} - the -default \code{na_level} (\code{""}) will also be excluded when \code{na.rm} is set to \code{TRUE}. +default \code{na_level} (\code{""}) will also be excluded when \code{na_rm} is set to \code{TRUE}. } \itemize{ @@ -293,7 +249,8 @@ created from character variables before passing the dataset to \code{\link[rtabl } \itemize{ -\item To use for comparison (with additional p-value statistic), parameter \code{compare} must be set to \code{TRUE}. +\item To use for comparison (with additional p-value statistic), parameter +\code{compare_with_ref_group} must be set to \code{TRUE}. \item Ensure that either all \code{NA} values are converted to an explicit \code{NA} level or all \code{NA} values are left as is. } } @@ -333,7 +290,7 @@ build_table(l, df = dta_test) l <- basic_table() \%>\% split_cols_by(var = "ARM") \%>\% split_rows_by(var = "AVISIT") \%>\% - analyze_vars(vars = "AVAL", na.rm = FALSE) + analyze_vars(vars = "AVAL", na_rm = FALSE) build_table(l, df = dta_test) @@ -342,7 +299,7 @@ dta_test$AVISIT <- NA_character_ dta_test <- df_explicit_na(dta_test) l <- basic_table() \%>\% split_cols_by(var = "ARM") \%>\% - analyze_vars(vars = "AVISIT", na.rm = FALSE) + analyze_vars(vars = "AVISIT", na_rm = FALSE) build_table(l, df = dta_test) @@ -363,17 +320,17 @@ s_summary(numeric()) ## Management of NA values. x <- c(NA_real_, 1) -s_summary(x, na.rm = TRUE) -s_summary(x, na.rm = FALSE) +s_summary(x, na_rm = TRUE) +s_summary(x, na_rm = FALSE) x <- c(NA_real_, 1, 2) -s_summary(x, stats = NULL) +s_summary(x) ## Benefits in `rtables` contructions: dta_test <- data.frame( - Group = rep(LETTERS[1:3], each = 2), - sub_group = rep(letters[1:2], each = 3), - x = 1:6 + Group = rep(LETTERS[seq(3)], each = 2), + sub_group = rep(letters[seq(2)], each = 3), + x = seq(6) ) ## The summary obtained in with `rtables`: @@ -398,8 +355,8 @@ s_summary(factor(levels = c("a", "b", "c"))) ## Management of NA values. x <- factor(c(NA, "Female")) x <- explicit_na(x) -s_summary(x, na.rm = TRUE) -s_summary(x, na.rm = FALSE) +s_summary(x, na_rm = TRUE) +s_summary(x, na_rm = FALSE) ## Different denominators. x <- factor(c("a", "a", "b", "c", "a")) @@ -409,8 +366,8 @@ s_summary(x, denom = "N_col", .N_col = 20L) # `s_summary.character` ## Basic usage: -s_summary(c("a", "a", "b", "c", "a"), .var = "x", verbose = FALSE) -s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na.rm = FALSE, verbose = FALSE) +s_summary(c("a", "a", "b", "c", "a"), verbose = FALSE) +s_summary(c("a", "a", "b", "c", "a", ""), .var = "x", na_rm = FALSE, verbose = FALSE) # `s_summary.logical` @@ -422,8 +379,8 @@ s_summary(as.logical(c())) ## Management of NA values. x <- c(NA, TRUE, FALSE) -s_summary(x, na.rm = TRUE) -s_summary(x, na.rm = FALSE) +s_summary(x, na_rm = TRUE) +s_summary(x, na_rm = FALSE) ## Different denominators. x <- c(TRUE, FALSE, TRUE, TRUE) @@ -433,22 +390,27 @@ s_summary(x, denom = "N_col", .N_col = 20L) a_summary(factor(c("a", "a", "b", "c", "a")), .N_row = 10, .N_col = 10) a_summary( factor(c("a", "a", "b", "c", "a")), - .ref_group = factor(c("a", "a", "b", "c")), compare = TRUE + .ref_group = factor(c("a", "a", "b", "c")), compare_with_ref_group = TRUE, .in_ref_col = TRUE ) a_summary(c("A", "B", "A", "C"), .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE) a_summary( c("A", "B", "A", "C"), - .ref_group = c("B", "A", "C"), .var = "x", compare = TRUE, verbose = FALSE + .ref_group = c("B", "A", "C"), .var = "x", compare_with_ref_group = TRUE, verbose = FALSE, + .in_ref_col = FALSE ) a_summary(c(TRUE, FALSE, FALSE, TRUE, TRUE), .N_row = 10, .N_col = 10) a_summary( c(TRUE, FALSE, FALSE, TRUE, TRUE), - .ref_group = c(TRUE, FALSE), .in_ref_col = TRUE, compare = TRUE + .ref_group = c(TRUE, FALSE), .in_ref_col = TRUE, compare_with_ref_group = TRUE, + .in_ref_col = FALSE ) a_summary(rnorm(10), .N_col = 10, .N_row = 20, .var = "bla") -a_summary(rnorm(10, 5, 1), .ref_group = rnorm(20, -5, 1), .var = "bla", compare = TRUE) +a_summary(rnorm(10, 5, 1), + .ref_group = rnorm(20, -5, 1), .var = "bla", compare_with_ref_group = TRUE, + .in_ref_col = FALSE +) } diff --git a/man/argument_convention.Rd b/man/argument_convention.Rd index f973f4135c..ba977fc4b4 100644 --- a/man/argument_convention.Rd +++ b/man/argument_convention.Rd @@ -37,6 +37,9 @@ that is passed by \code{rtables}.} \item{.stats}{(\code{character})\cr statistics to select for the table.} +\item{.stat_names_in}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \item{.var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested by a statistics function.} @@ -79,6 +82,8 @@ two proportions. For options, see \code{\link[=test_proportion_diff]{test_propor \item{na.rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} +\item{na_rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} + \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 _if diff --git a/man/compare_variables.Rd b/man/compare_variables.Rd index b5b611ffd9..08dbdf41dd 100644 --- a/man/compare_variables.Rd +++ b/man/compare_variables.Rd @@ -17,34 +17,26 @@ compare_vars( na_str = default_na_str(), nested = TRUE, ..., - na.rm = TRUE, + na_rm = TRUE, show_labels = "default", table_names = vars, section_div = NA_character_, .stats = c("n", "mean_sd", "count_fraction", "pval"), + .stat_names_in = NULL, .formats = NULL, .labels = NULL, .indent_mods = NULL ) -s_compare(x, .ref_group, .in_ref_col, ...) +s_compare(x, ...) -\method{s_compare}{numeric}(x, .ref_group, .in_ref_col, ...) +\method{s_compare}{numeric}(x, ...) -\method{s_compare}{factor}(x, .ref_group, .in_ref_col, denom = "n", na.rm = TRUE, ...) +\method{s_compare}{factor}(x, ...) -\method{s_compare}{character}( - x, - .ref_group, - .in_ref_col, - denom = "n", - na.rm = TRUE, - .var, - verbose = TRUE, - ... -) +\method{s_compare}{character}(x, ...) -\method{s_compare}{logical}(x, .ref_group, .in_ref_col, na.rm = TRUE, denom = "n", ...) +\method{s_compare}{logical}(x, ...) } \arguments{ \item{lyt}{(\code{PreDataTableLayouts})\cr layout that analyses will be added to.} @@ -59,9 +51,18 @@ s_compare(x, .ref_group, .in_ref_col, ...) 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{...}{arguments passed to \code{s_compare()}.} +\item{...}{additional arguments passed to \code{s_compare()}, including: +\itemize{ +\item \code{denom}: (\code{string}) choice of denominator. Options are \code{c("n", "N_col", "N_row")}. For factor variables, can +only be \code{"n"} (number of values in this row and column intersection). +\item \code{.N_row}: (\code{numeric(1)}) Row-wise N (row group count) for the group of observations being analyzed (i.e. with no +column-based subsetting). +\item \code{.N_col}: (\code{numeric(1)}) Column-wise N (column count) for the full column being tabulated within. +\item \code{verbose}: (\code{flag}) Whether additional warnings and messages should be printed. Mainly used to print out +information about factor casting. Defaults to \code{TRUE}. Used for \code{character}/\code{factor} variables only. +}} -\item{na.rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} +\item{na_rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} \item{show_labels}{(\code{string})\cr label visibility: one of "default", "visible" and "hidden".} @@ -77,6 +78,9 @@ Options for numeric variables are: \verb{'n', 'sum', 'mean', 'sd', 'se', 'mean_s Options for non-numeric variables are: \verb{'n', 'count', 'count_fraction', 'count_fraction_fixed_dp', 'fraction', 'n_blq', 'pval_counts'}} +\item{.stat_names_in}{(\code{character})\cr names of the statistics that are passed directly to name single statistics +(\code{.stats}). This option is visible when producing \code{\link[rtables:data.frame_export]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} + \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.} @@ -87,19 +91,6 @@ should be a name-value pair with name corresponding to a statistic specified in for that statistic's row label.} \item{x}{(\code{numeric})\cr vector of numbers we want to analyze.} - -\item{.ref_group}{(\code{data.frame} or \code{vector})\cr the data corresponding to the reference group.} - -\item{.in_ref_col}{(\code{flag})\cr \code{TRUE} when working with the reference level, \code{FALSE} otherwise.} - -\item{denom}{(\code{string})\cr choice of denominator for factor proportions, -can only be \code{n} (number of values in this row and column intersection).} - -\item{.var}{(\code{string})\cr single variable name that is passed by \code{rtables} when requested -by a statistics function.} - -\item{verbose}{(\code{flag})\cr whether warnings and messages should be printed. Mainly used -to print out information about factor casting. Defaults to \code{TRUE}.} } \value{ \itemize{ @@ -204,8 +195,8 @@ s_compare(x = x, .ref_group = y, .in_ref_col = FALSE) ## Management of NA values. x <- explicit_na(factor(c("a", "a", "b", "c", "a", NA, NA))) y <- explicit_na(factor(c("a", "b", "c", NA))) -s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na.rm = TRUE) -s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na.rm = FALSE) +s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na_rm = TRUE) +s_compare(x = x, .ref_group = y, .in_ref_col = FALSE, na_rm = FALSE) # `s_compare.character` @@ -236,8 +227,8 @@ s_compare(x, .ref_group = y, .in_ref_col = FALSE) ## Management of NA values. x <- c(NA, TRUE, FALSE) y <- c(NA, NA, NA, NA, FALSE) -s_compare(x, .ref_group = y, .in_ref_col = FALSE, na.rm = TRUE) -s_compare(x, .ref_group = y, .in_ref_col = FALSE, na.rm = FALSE) +s_compare(x, .ref_group = y, .in_ref_col = FALSE, na_rm = TRUE) +s_compare(x, .ref_group = y, .in_ref_col = FALSE, na_rm = FALSE) } \seealso{ diff --git a/man/count_patients_with_event.Rd b/man/count_patients_with_event.Rd index 3ae18641eb..cc0e7dacd1 100644 --- a/man/count_patients_with_event.Rd +++ b/man/count_patients_with_event.Rd @@ -25,8 +25,8 @@ s_count_patients_with_event( df, .var, filters, - .N_col, - .N_row, + .N_col = ncol(df), + .N_row = nrow(df), denom = c("n", "N_col", "N_row") ) @@ -34,9 +34,9 @@ a_count_patients_with_event( df, labelstr = "", filters, - denom = c("n", "N_col", "N_row"), .N_col, .N_row, + denom = c("n", "N_col", "N_row"), .df_row, .var = NULL, .stats = NULL, @@ -181,7 +181,7 @@ build_table(lyt, tern_ex_adae, alt_counts_df = tern_ex_adsl) s_count_patients_with_event( tern_ex_adae, .var = "SUBJID", - filters = c("TRTEMFL" = "Y") + filters = c("TRTEMFL" = "Y"), ) s_count_patients_with_event( diff --git a/man/count_patients_with_flags.Rd b/man/count_patients_with_flags.Rd index 6666d74065..1509119f50 100644 --- a/man/count_patients_with_flags.Rd +++ b/man/count_patients_with_flags.Rd @@ -29,8 +29,8 @@ s_count_patients_with_flags( .var, flag_variables, flag_labels = NULL, - .N_col, - .N_row, + .N_col = ncol(df), + .N_row = nrow(df), denom = c("n", "N_col", "N_row") ) @@ -40,8 +40,8 @@ a_count_patients_with_flags( flag_variables, flag_labels = NULL, denom = c("n", "N_col", "N_row"), - .N_col, - .N_row, + .N_col = ncol(df), + .N_row = nrow(df), .df_row, .var = NULL, .stats = NULL, diff --git a/man/count_values.Rd b/man/count_values.Rd index 39b44918ba..c40f7d4f1d 100644 --- a/man/count_values.Rd +++ b/man/count_values.Rd @@ -23,14 +23,7 @@ count_values( .indent_mods = NULL ) -s_count_values( - x, - values, - na.rm = TRUE, - .N_col, - .N_row, - denom = c("n", "N_col", "N_row") -) +s_count_values(x, values, na.rm = TRUE, denom = c("n", "N_col", "N_row"), ...) \method{s_count_values}{character}(x, values = "Y", na.rm = TRUE, ...) @@ -38,14 +31,7 @@ s_count_values( \method{s_count_values}{logical}(x, values = TRUE, ...) -a_count_values( - x, - values, - na.rm = TRUE, - .N_col, - .N_row, - denom = c("n", "N_col", "N_row") -) +a_count_values(x, values, na.rm = TRUE, denom = c("n", "N_col", "N_row"), ...) } \arguments{ \item{lyt}{(\code{PreDataTableLayouts})\cr layout that analyses will be added to.} @@ -81,12 +67,6 @@ unmodified default behavior. Can be negative.} \item{na.rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} -\item{.N_col}{(\code{integer(1)})\cr column-wise N (column count) for the full column being analyzed that is typically -passed by \code{rtables}.} - -\item{.N_row}{(\code{integer(1)})\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 \code{rtables}.} - \item{denom}{(\code{string})\cr choice of denominator for proportion. Options are: \itemize{ \item \code{n}: number of values in this row and column intersection. diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index 3fbcad8fad..41bef86827 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -4,6 +4,7 @@ \name{default_stats_formats_labels} \alias{default_stats_formats_labels} \alias{get_stats} +\alias{get_stat_names} \alias{get_formats_from_stats} \alias{get_labels_from_stats} \alias{get_indents_from_stats} @@ -36,9 +37,11 @@ get_stats( add_pval = FALSE ) +get_stat_names(stat_results, stat_names_in = NULL) + get_formats_from_stats(stats, formats_in = NULL) -get_labels_from_stats(stats, labels_in = NULL, row_nms = NULL) +get_labels_from_stats(stats, labels_in = NULL, levels_per_stats = NULL) get_indents_from_stats(stats, indents_in = NULL, row_nms = NULL) @@ -62,6 +65,11 @@ method group.} \item{add_pval}{(\code{flag})\cr should \code{"pval"} (or \code{"pval_counts"} if \code{method_groups} contains \code{"analyze_vars_counts"}) be added to the statistical methods?} +\item{stat_results}{(\code{list})\cr list of statistical results. It should be used close to the end of +a statistical function. See examples for a structure with two statistical results and two groups.} + +\item{stat_names_in}{(\code{character})\cr custom modification of statistical values.} + \item{stats}{(\code{character})\cr statistical methods to get defaults for.} \item{formats_in}{(named \code{vector})\cr inserted formats to replace defaults. It can be a @@ -69,7 +77,7 @@ character vector from \code{\link[formatters:list_formats]{formatters::list_vali \item{labels_in}{(named \code{character})\cr inserted labels to replace defaults.} -\item{row_nms}{(\code{character})\cr row names. Levels of a \code{factor} or \code{character} variable, each +\item{levels_per_stats}{(named \code{list} of \code{character} or \code{NULL})\cr Levels of a \code{factor} or \code{character} variable, each of which the statistics in \code{.stats} will be calculated for. If this parameter is set, these variable levels will be used as the defaults, and the names of the given custom values should correspond to levels (or have format \code{statistic.level}) instead of statistics. Can also be @@ -77,6 +85,8 @@ variable names if rows correspond to different variables instead of levels. Defa \item{indents_in}{(named \code{vector})\cr inserted indent modifiers to replace defaults (default is \code{0L}).} +\item{row_nms}{(\code{character})\cr See \code{levels_per_stats}. Deprecation cycle started.} + \item{type}{(\code{string})\cr \code{"numeric"} or \code{"counts"}.} \item{include_pval}{(\code{flag})\cr same as the \code{add_pval} argument in \code{\link[=get_stats]{get_stats()}}.} @@ -86,6 +96,11 @@ variable names if rows correspond to different variables instead of levels. Defa \item \code{get_stats()} returns a \code{character} vector of statistical methods. } +\itemize{ +\item \code{get_stat_names()} returns a named list of\code{character} vectors, indicating the names of +statistical outputs. +} + \itemize{ \item \code{get_formats_from_stats()} returns a named vector of formats (if present in either \code{tern_default_formats} or \code{formats_in}, otherwise \code{NULL}). Values can be taken from @@ -129,6 +144,9 @@ Current choices for \code{type} are \code{counts} and \code{numeric} for \code{\ \item \code{get_stats()}: Get statistics available for a given method group (analyze function). To check available defaults see \code{tern::tern_default_stats} list. +\item \code{get_stat_names()}: Get statistical NAMES available for a given method +group (analyze function). Please use the \verb{s_*} functions to get the statistical names. + \item \code{get_formats_from_stats()}: Get formats corresponding to a list of statistics. To check available defaults see \code{tern::tern_default_formats} list. @@ -177,6 +195,13 @@ all_cnt_occ <- get_stats("count_occurrences") # Multiple get_stats(c("count_occurrences", "analyze_vars_counts")) +stat_results <- list( + "n" = list("M" = 1, "F" = 2), + "count_fraction" = list("M" = c(1, 0.2), "F" = c(2, 0.1)) +) +get_stat_names(stat_results) +get_stat_names(stat_results, list("n" = "argh")) + # Defaults formats get_formats_from_stats(num_stats) get_formats_from_stats(cnt_stats) diff --git a/man/summarize_change.Rd b/man/summarize_change.Rd index f324348b6a..c99ec2b13f 100644 --- a/man/summarize_change.Rd +++ b/man/summarize_change.Rd @@ -49,6 +49,8 @@ a_change_from_baseline( \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} +\item{na_rm}{(\code{flag})\cr whether \code{NA} values should be removed from \code{x} prior to analysis.} + \item{nested}{(\code{flag})\cr whether this layout instruction should be applied within the existing layout structure _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/ungroup_stats.Rd b/man/ungroup_stats.Rd index de07500cbc..0a6241a18f 100644 --- a/man/ungroup_stats.Rd +++ b/man/ungroup_stats.Rd @@ -4,21 +4,19 @@ \alias{ungroup_stats} \title{Ungroup non-numeric statistics} \usage{ -ungroup_stats(x, .formats, .labels, .indent_mods) +ungroup_stats(stat_out, .formats, .indent_mods) } \arguments{ -\item{x}{(named \code{list} of \code{numeric})\cr list of numeric statistics containing the statistics to ungroup.} +\item{stat_out}{(named \code{list} of \code{numeric})\cr list of numeric statistics containing the statistics to ungroup.} \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{.labels}{(named \code{character})\cr labels for the statistics (without indent).} - \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.} } \value{ -A \code{list} with modified elements \code{x}, \code{.formats}, \code{.labels}, and \code{.indent_mods}. +A \code{list} with modified elements \code{stat_out}, \code{.formats}, \code{.labels}, \code{.levels}, and \code{.indent_mods}. } \description{ Ungroups grouped non-numeric statistics within input vectors \code{.formats}, \code{.labels}, and \code{.indent_mods}. diff --git a/tern.Rproj b/tern.Rproj index 4f69393588..0bb3afe52a 100644 --- a/tern.Rproj +++ b/tern.Rproj @@ -1,4 +1,5 @@ Version: 1.0 +ProjectId: 74d75484-65e8-447e-93c0-fca42c4aeacd RestoreWorkspace: Default SaveWorkspace: Default diff --git a/tests/testthat/_snaps/analyze_variables.md b/tests/testthat/_snaps/analyze_variables.md index 021a9756f7..933275e458 100644 --- a/tests/testthat/_snaps/analyze_variables.md +++ b/tests/testthat/_snaps/analyze_variables.md @@ -694,28 +694,51 @@ res Output $n - [1] 9 + $n$n + n + 9 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 3 + count + 3 $count$Unknown - [1] 4 + count + 4 $count_fraction $count_fraction$Female - [1] 2.0000000 0.2222222 + count p + 2.0000000 0.2222222 $count_fraction$Male - [1] 3.0000000 0.3333333 + count p + 3.0000000 0.3333333 $count_fraction$Unknown - [1] 4.0000000 0.4444444 + count p + 4.0000000 0.4444444 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.0000000 0.2222222 + + $count_fraction_fixed_dp$Male + count p + 3.0000000 0.3333333 + + $count_fraction_fixed_dp$Unknown + count p + 4.0000000 0.4444444 $fraction @@ -733,7 +756,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works when factors have NA levels @@ -742,34 +768,63 @@ res Output $n - [1] 7 + $n$n + n + 7 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 2 + count + 2 $count$Unknown - [1] 2 + count + 2 $count$`NA` - [1] 1 + count + 1 $count_fraction $count_fraction$Female - [1] 2.0000000 0.2857143 + count p + 2.0000000 0.2857143 $count_fraction$Male - [1] 2.0000000 0.2857143 + count p + 2.0000000 0.2857143 $count_fraction$Unknown - [1] 2.0000000 0.2857143 + count p + 2.0000000 0.2857143 $count_fraction$`NA` - [1] 1.0000000 0.1428571 + count p + 1.0000000 0.1428571 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.0000000 0.2857143 + + $count_fraction_fixed_dp$Male + count p + 2.0000000 0.2857143 + + $count_fraction_fixed_dp$Unknown + count p + 2.0000000 0.2857143 + + $count_fraction_fixed_dp$`NA` + count p + 1.0000000 0.1428571 $fraction @@ -791,7 +846,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works with factors with NA values handled and correctly removes them by default @@ -800,28 +858,51 @@ res Output $n - [1] 9 + $n$n + n + 9 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 3 + count + 3 $count$Unknown - [1] 4 + count + 4 $count_fraction $count_fraction$Female - [1] 2.0000000 0.2222222 + count p + 2.0000000 0.2222222 $count_fraction$Male - [1] 3.0000000 0.3333333 + count p + 3.0000000 0.3333333 $count_fraction$Unknown - [1] 4.0000000 0.4444444 + count p + 4.0000000 0.4444444 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.0000000 0.2222222 + + $count_fraction_fixed_dp$Male + count p + 3.0000000 0.3333333 + + $count_fraction_fixed_dp$Unknown + count p + 4.0000000 0.4444444 $fraction @@ -839,7 +920,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works with length 0 factors that have levels @@ -848,28 +932,51 @@ res Output $n - [1] 0 + $n$n + n + 0 + $count $count$a - [1] 0 + count + 0 $count$b - [1] 0 + count + 0 $count$c - [1] 0 + count + 0 $count_fraction $count_fraction$a - [1] 0 0 + count p + 0 0 $count_fraction$b - [1] 0 0 + count p + 0 0 $count_fraction$c - [1] 0 0 + count p + 0 0 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$a + count p + 0 0 + + $count_fraction_fixed_dp$b + count p + 0 0 + + $count_fraction_fixed_dp$c + count p + 0 0 $fraction @@ -887,7 +994,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works with factors and different denominator choices @@ -896,28 +1006,51 @@ res Output $n - [1] 9 + $n$n + n + 9 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 3 + count + 3 $count$Unknown - [1] 4 + count + 4 $count_fraction $count_fraction$Female - [1] 2.0 0.1 + count p + 2.0 0.1 $count_fraction$Male - [1] 3.00 0.15 + count p + 3.00 0.15 $count_fraction$Unknown - [1] 4.0 0.2 + count p + 4.0 0.2 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.0 0.1 + + $count_fraction_fixed_dp$Male + count p + 3.00 0.15 + + $count_fraction_fixed_dp$Unknown + count p + 4.0 0.2 $fraction @@ -935,7 +1068,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + --- @@ -944,28 +1080,51 @@ res Output $n - [1] 9 + $n$n + n + 9 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 3 + count + 3 $count$Unknown - [1] 4 + count + 4 $count_fraction $count_fraction$Female - [1] 2.00000000 0.06666667 + count p + 2.00000000 0.06666667 $count_fraction$Male - [1] 3.0 0.1 + count p + 3.0 0.1 $count_fraction$Unknown - [1] 4.0000000 0.1333333 + count p + 4.0000000 0.1333333 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.00000000 0.06666667 + + $count_fraction_fixed_dp$Male + count p + 3.0 0.1 + + $count_fraction_fixed_dp$Unknown + count p + 4.0000000 0.1333333 $fraction @@ -983,7 +1142,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works with characters by converting to character and handling empty strings @@ -992,34 +1154,63 @@ res Output $n - [1] 10 + $n$n + n + 10 + $count $count$Female - [1] 2 + count + 2 $count$Male - [1] 3 + count + 3 $count$Unknown - [1] 4 + count + 4 $count$`NA` - [1] 1 + count + 1 $count_fraction $count_fraction$Female - [1] 2.0 0.2 + count p + 2.0 0.2 $count_fraction$Male - [1] 3.0 0.3 + count p + 3.0 0.3 $count_fraction$Unknown - [1] 4.0 0.4 + count p + 4.0 0.4 $count_fraction$`NA` - [1] 1.0 0.1 + count p + 1.0 0.1 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$Female + count p + 2.0 0.2 + + $count_fraction_fixed_dp$Male + count p + 3.0 0.3 + + $count_fraction_fixed_dp$Unknown + count p + 4.0 0.4 + + $count_fraction_fixed_dp$`NA` + count p + 1.0 0.1 $fraction @@ -1041,7 +1232,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + # s_summary works with logical vectors @@ -1050,16 +1244,28 @@ res Output $n - [1] 6 + n + 6 $count - [1] 4 + count + 4 $count_fraction - [1] 4.0000000 0.6666667 + count fraction + 4.0000000 0.6666667 + + $count_fraction_fixed_dp + count fraction + 4.0000000 0.6666667 + + $fraction + num denom + 4 6 $n_blq - [1] 0 + n_blq + 0 # s_summary works with length 0 logical vectors @@ -1068,16 +1274,28 @@ res Output $n - [1] 0 + n + 0 $count - [1] 0 + count + 0 $count_fraction - [1] 0 0 + count fraction + 0 0 + + $count_fraction_fixed_dp + count fraction + 0 0 + + $fraction + num denom + 0 0 $n_blq - [1] 0 + n_blq + 0 # s_summary works with logical vectors and by default removes NA @@ -1086,16 +1304,28 @@ res Output $n - [1] 6 + n + 6 $count - [1] 4 + count + 4 $count_fraction - [1] 4.0000000 0.6666667 + count fraction + 4.0000000 0.6666667 + + $count_fraction_fixed_dp + count fraction + 4.0000000 0.6666667 + + $fraction + num denom + 4 6 $n_blq - [1] 0 + n_blq + 0 # s_summary works with logical vectors and by if requested does not remove NA from n @@ -1104,16 +1334,28 @@ res Output $n - [1] 8 + n + 8 $count - [1] 4 + count + 4 $count_fraction - [1] 4.0 0.5 + count fraction + 4.0 0.5 + + $count_fraction_fixed_dp + count fraction + 4.0 0.5 + + $fraction + num denom + 4 8 $n_blq - [1] 0 + n_blq + 0 # a_summary work with healthy input. @@ -1160,7 +1402,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 5 0 n + 1 n.n 5 0 n 2 count.a 3 0 a 3 count.b 1 0 b 4 count.c 1 0 c @@ -1173,7 +1415,7 @@ 11 fraction.a 3/5 (60.0%) 0 a 12 fraction.b 1/5 (20.0%) 0 b 13 fraction.c 1/5 (20.0%) 0 c - 14 n_blq 0 0 n_blq + 14 n_blq.n_blq 0 0 n_blq --- @@ -1183,7 +1425,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 4 0 n + 1 n.n 4 0 n 2 count.A 2 0 A 3 count.B 1 0 B 4 count.C 1 0 C @@ -1196,7 +1438,7 @@ 11 fraction.A 2/4 (50.0%) 0 A 12 fraction.B 1/4 (25.0%) 0 B 13 fraction.C 1/4 (25.0%) 0 C - 14 n_blq 0 0 n_blq + 14 n_blq.n_blq 0 0 n_blq --- @@ -1205,13 +1447,13 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 5 0 n - 2 count 3 0 count - 3 count_fraction 3 (60%) 0 count_fraction - 4 count_fraction_fixed_dp 3 (60.0%) 0 count_fraction - 5 fraction 0 fraction - 6 n_blq 0 0 n_blq + row_name formatted_cell indent_mod row_label + 1 n 5 0 n + 2 count 3 0 count + 3 count_fraction 3 (60%) 0 count_fraction + 4 count_fraction_fixed_dp 3 (60.0%) 0 count_fraction_fixed_dp + 5 fraction 3/5 (60.0%) 0 fraction + 6 n_blq 0 0 n_blq # a_summary works with custom input. @@ -1222,7 +1464,7 @@ ---------------------------- row_name formatted_cell indent_mod row_label 1 sd 1 3 std. dev - 2 median_ci -0.62 - 1.12 3 Median 95% CI + 2 median_ci -0.82 - 0.74 3 Median 90% CI --- @@ -1232,7 +1474,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 5.00 -1 number of records + 1 n.n 5.00 -1 number of records 2 count.a 2 5 a 3 count.b 1 5 b 4 count.c 1 5 c @@ -1249,9 +1491,9 @@ 15 fraction.b 1/5 (20.0%) 0 b 16 fraction.c 1/5 (20.0%) 0 c 17 fraction.NA 1/5 (20.0%) 0 NA - 18 n_blq 0 0 n_blq + 18 n_blq.n_blq 0 0 n_blq -# a_summary works with healthy input when compare = TRUE. +# a_summary works with healthy input when compare_with_ref_group = TRUE. Code res @@ -1260,32 +1502,32 @@ ---------------------------- row_name formatted_cell indent_mod row_label 1 n 10 0 n - 2 sum 51.3 0 Sum - 3 mean 5.1 0 Mean - 4 sd 0.8 0 SD - 5 se 0.2 0 SE - 6 mean_sd 5.1 (0.8) 0 Mean (SD) - 7 mean_se 5.1 (0.2) 0 Mean (SE) - 8 mean_ci (4.57, 5.69) 0 Mean 95% CI - 9 mean_sei (4.89, 5.38) 0 Mean -/+ 1xSE - 10 mean_sdi (4.35, 5.91) 0 Mean -/+ 1xSD + 2 sum 48.7 0 Sum + 3 mean 4.9 0 Mean + 4 sd 1.0 0 SD + 5 se 0.3 0 SE + 6 mean_sd 4.9 (1.0) 0 Mean (SD) + 7 mean_se 4.9 (0.3) 0 Mean (SE) + 8 mean_ci (4.18, 5.55) 0 Mean 95% CI + 9 mean_sei (4.56, 5.17) 0 Mean -/+ 1xSE + 10 mean_sdi (3.91, 5.82) 0 Mean -/+ 1xSD 11 mean_pval <0.0001 0 Mean p-value (H0: mean = 0) - 12 median 5.3 0 Median - 13 mad -0.0 0 Median Absolute Deviation - 14 median_ci (4.18, 5.74) 0 Median 95% CI - 15 quantiles 4.4 - 5.6 0 25% and 75%-ile - 16 iqr 1.2 0 IQR - 17 range 4.2 - 6.6 0 Min - Max - 18 min 4.2 0 Minimum - 19 max 6.6 0 Maximum - 20 median_range 5.3 (4.2 - 6.6) 0 Median (Min - Max) - 21 cv 15.2 0 CV (%) - 22 geom_mean 5.1 0 Geometric Mean - 23 geom_mean_ci (4.56, 5.66) 0 Geometric Mean 95% CI - 24 geom_cv 15.2 0 CV % Geometric Mean - 25 median_ci_3d 5.26 (4.18 - 5.74) 0 Median (95% CI) - 26 mean_ci_3d 5.13 (4.57 - 5.69) 0 Mean (95% CI) - 27 geom_mean_ci_3d 5.08 (4.56 - 5.66) 0 Geometric Mean (95% CI) + 12 median 5.0 0 Median + 13 mad 0.0 0 Median Absolute Deviation + 14 median_ci (3.53, 5.78) 0 Median 95% CI + 15 quantiles 4.5 - 5.6 0 25% and 75%-ile + 16 iqr 1.1 0 IQR + 17 range 3.0 - 5.9 0 Min - Max + 18 min 3.0 0 Minimum + 19 max 5.9 0 Maximum + 20 median_range 5.0 (3.0 - 5.9) 0 Median (Min - Max) + 21 cv 19.6 0 CV (%) + 22 geom_mean 4.8 0 Geometric Mean + 23 geom_mean_ci (4.07, 5.58) 0 Geometric Mean 95% CI + 24 geom_cv 22.3 0 CV % Geometric Mean + 25 median_ci_3d 5.01 (3.53 - 5.78) 0 Median (95% CI) + 26 mean_ci_3d 4.87 (4.18 - 5.55) 0 Mean (95% CI) + 27 geom_mean_ci_3d 4.77 (4.07 - 5.58) 0 Geometric Mean (95% CI) 28 pval <0.0001 0 p-value (t-test) --- @@ -1296,7 +1538,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 5 0 n + 1 n.n 5 0 n 2 count.a 3 0 a 3 count.b 1 0 b 4 count.c 1 0 c @@ -1309,8 +1551,8 @@ 11 fraction.a 3/5 (60.0%) 0 a 12 fraction.b 1/5 (20.0%) 0 b 13 fraction.c 1/5 (20.0%) 0 c - 14 n_blq 0 0 n_blq - 15 pval_counts 0.9560 0 p-value (chi-squared test) + 14 n_blq.n_blq 0 0 n_blq + 15 pval_counts.pval_counts 0.9560 0 p-value (chi-squared test) --- @@ -1320,7 +1562,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 4 0 n + 1 n.n 4 0 n 2 count.A 2 0 A 3 count.B 1 0 B 4 count.C 1 0 C @@ -1333,8 +1575,8 @@ 11 fraction.A 2/4 (50.0%) 0 A 12 fraction.B 1/4 (25.0%) 0 B 13 fraction.C 1/4 (25.0%) 0 C - 14 n_blq 0 0 n_blq - 15 pval_counts 0.9074 0 p-value (chi-squared test) + 14 n_blq.n_blq 0 0 n_blq + 15 pval_counts.pval_counts 0.9074 0 p-value (chi-squared test) --- @@ -1347,12 +1589,12 @@ 1 n 5 0 n 2 count 3 0 count 3 count_fraction 3 (60%) 0 count_fraction - 4 count_fraction_fixed_dp 3 (60.0%) 0 count_fraction - 5 fraction 0 fraction + 4 count_fraction_fixed_dp 3 (60.0%) 0 count_fraction_fixed_dp + 5 fraction 3/5 (60.0%) 0 fraction 6 n_blq 0 0 n_blq 7 pval_counts 0.8091 0 p-value (chi-squared test) -# a_summary works with custom input when compare = TRUE. +# a_summary works with custom input when compare_with_ref_group = TRUE. Code res @@ -1361,7 +1603,7 @@ ---------------------------- row_name formatted_cell indent_mod row_label 1 pval <0.0001 3 pvalue - 2 median_ci -0.41 - 1.10 3 Median 95% CI + 2 median_ci -1.47 - 0.78 3 Median 95% CI --- @@ -1371,7 +1613,7 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 n 5.00 -1 number of records + 1 n.n 5.00 -1 number of records 2 count.a 2 5 a 3 count.b 1 5 b 4 count.c 1 5 c @@ -1388,10 +1630,10 @@ 15 fraction.b 1/5 (20.0%) 0 b 16 fraction.c 1/5 (20.0%) 0 c 17 fraction.NA 1/5 (20.0%) 0 NA - 18 n_blq 0 0 n_blq - 19 pval_counts 0.8254 0 p-value (chi-squared test) + 18 n_blq.n_blq 0 0 n_blq + 19 pval_counts.pval_counts 0.8254 0 p-value (chi-squared test) -# `analyze_vars` works with healthy input, default `na.rm = TRUE`. +# `analyze_vars` works with healthy input, default `na_rm = TRUE`. Code res @@ -1416,7 +1658,7 @@ Mean 90% CI (3.30, 6.70) 10% and 90%-ile 1.0 - 9.0 -# `analyze_vars` works with healthy input, alternative `na.rm = FALSE` +# `analyze_vars` works with healthy input, alternative `na_rm = FALSE` Code res @@ -1439,7 +1681,7 @@ a 2 (66.7%) b 1 (33.3%) -# `analyze_vars` works with healthy factor input, alternative `na.rm = FALSE` +# `analyze_vars` works with healthy factor input, alternative `na_rm = FALSE` Code res @@ -1598,7 +1840,7 @@ n 5 count_fraction 3 (60%) -# `analyze_vars` works with healthy logical input, alternative `na.rm = FALSE` +# `analyze_vars` works with healthy logical input, alternative `na_rm = FALSE` Code res diff --git a/tests/testthat/_snaps/compare_variables.md b/tests/testthat/_snaps/compare_variables.md index 6c98b121bb..8082454779 100644 --- a/tests/testthat/_snaps/compare_variables.md +++ b/tests/testthat/_snaps/compare_variables.md @@ -23,8 +23,10 @@ Code res Output - [1] "n" "count" "count_fraction" "fraction" - [5] "n_blq" "pval_counts" + [1] "n" "count" + [3] "count_fraction" "count_fraction_fixed_dp" + [5] "fraction" "n_blq" + [7] "pval_counts" --- @@ -53,28 +55,51 @@ res Output $n - [1] 5 + $n$n + n + 5 + $count $count$a - [1] 3 + count + 3 $count$b - [1] 1 + count + 1 $count$c - [1] 1 + count + 1 $count_fraction $count_fraction$a - [1] 3.0 0.6 + count p + 3.0 0.6 $count_fraction$b - [1] 1.0 0.2 + count p + 1.0 0.2 $count_fraction$c - [1] 1.0 0.2 + count p + 1.0 0.2 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$a + count p + 3.0 0.6 + + $count_fraction_fixed_dp$b + count p + 1.0 0.2 + + $count_fraction_fixed_dp$c + count p + 1.0 0.2 $fraction @@ -92,7 +117,10 @@ $n_blq - [1] 0 + $n_blq$n_blq + n_blq + 0 + $pval_counts [1] 0.7659283 diff --git a/tests/testthat/_snaps/count_occurrences.md b/tests/testthat/_snaps/count_occurrences.md index 167e4e1ba4..f83795a340 100644 --- a/tests/testthat/_snaps/count_occurrences.md +++ b/tests/testthat/_snaps/count_occurrences.md @@ -25,6 +25,17 @@ [1] 1.00 0.25 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$MH1 + [1] 3.00 0.75 + + $count_fraction_fixed_dp$MH2 + [1] 1.00 0.25 + + $count_fraction_fixed_dp$MH3 + [1] 1.00 0.25 + + $fraction $fraction$MH1 num denom @@ -67,6 +78,17 @@ [1] 1.0000000 0.3333333 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$MH1 + [1] 3 1 + + $count_fraction_fixed_dp$MH2 + [1] 1.0000000 0.3333333 + + $count_fraction_fixed_dp$MH3 + [1] 1.0000000 0.3333333 + + $fraction $fraction$MH1 num denom @@ -89,15 +111,23 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 Level: a 3 1 Level: a - 2 LVL B 1 2 LVL B - 3 Count of c 1 0 Count of c - 4 Missing D 0 3 Missing D - 5 Level: a 3 (60%) 1 Level: a - 6 LVL B 1 (20%) 2 LVL B - 7 c 1 (20%) 0 c - 8 Missing D 0 (0%) 0 Missing D + row_name formatted_cell indent_mod row_label + 1 Level: a 3 1 Level: a + 2 LVL B 1 2 LVL B + 3 Count of c 1 0 Count of c + 4 Missing D 0 3 Missing D + 5 Level: a 3 (60%) 1 Level: a + 6 LVL B 1 (20%) 2 LVL B + 7 c 1 (20%) 0 c + 8 Missing D 0 (0%) 0 Missing D + 9 Level: a 3 1 Level: a + 10 LVL B 1 2 LVL B + 11 c 1 0 c + 12 Missing D 0 3 Missing D + 13 Level: a 3 (60%) 1 Level: a + 14 LVL B 1 (20%) 2 LVL B + 15 c 1 (20%) 0 c + 16 Missing D 0 (0%) 0 Missing D # count_occurrences functions as expected with valid input and default arguments diff --git a/tests/testthat/_snaps/count_occurrences_by_grade.md b/tests/testthat/_snaps/count_occurrences_by_grade.md index 94cf945880..cc984cb18f 100644 --- a/tests/testthat/_snaps/count_occurrences_by_grade.md +++ b/tests/testthat/_snaps/count_occurrences_by_grade.md @@ -77,6 +77,23 @@ [1] 0 0 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`1` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`2` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`3` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`4` + [1] 0 0 + + $count_fraction_fixed_dp$`5` + [1] 0 0 + + --- @@ -100,6 +117,23 @@ [1] 0 0 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`1` + [1] 0 0 + + $count_fraction_fixed_dp$`2` + [1] 0 0 + + $count_fraction_fixed_dp$`3` + [1] 0 0 + + $count_fraction_fixed_dp$`4` + [1] 0 0 + + $count_fraction_fixed_dp$`5` + [1] 0 0 + + # s_count_occurrences_by_grade sorts grade levels so that 'missing' level appears last @@ -126,6 +160,26 @@ [1] 1.0 0.1 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`1` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`2` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`3` + [1] 1.0 0.1 + + $count_fraction_fixed_dp$`4` + [1] 0 0 + + $count_fraction_fixed_dp$`5` + [1] 0 0 + + $count_fraction_fixed_dp$Missing + [1] 1.0 0.1 + + # s_count_occurrences_by_grade works with valid input for grade grouping @@ -158,6 +212,32 @@ [1] 0 0 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Any Grade` + [1] 6.0 0.6 + + $count_fraction_fixed_dp$`Grade 1-2` + [1] 4.0 0.4 + + $count_fraction_fixed_dp$`1` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`2` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`Grade 3-4` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`3` + [1] 2.0 0.2 + + $count_fraction_fixed_dp$`4` + [1] 0 0 + + $count_fraction_fixed_dp$`5` + [1] 0 0 + + --- @@ -190,6 +270,32 @@ [1] 0 0 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Any Grade` + [1] 0 0 + + $count_fraction_fixed_dp$`Grade 1-2` + [1] 0 0 + + $count_fraction_fixed_dp$`1` + [1] 0 0 + + $count_fraction_fixed_dp$`2` + [1] 0 0 + + $count_fraction_fixed_dp$`Grade 3-4` + [1] 0 0 + + $count_fraction_fixed_dp$`3` + [1] 0 0 + + $count_fraction_fixed_dp$`4` + [1] 0 0 + + $count_fraction_fixed_dp$`5` + [1] 0 0 + + --- @@ -207,6 +313,17 @@ [1] 2.0 0.2 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Any Grade` + [1] 6.0 0.6 + + $count_fraction_fixed_dp$`Grade 1-2` + [1] 4.0 0.4 + + $count_fraction_fixed_dp$`Grade 3-4` + [1] 2.0 0.2 + + # s_count_occurrences_by_grade works with valid input for intensity and custom arguments @@ -227,6 +344,20 @@ [1] 2.0 0.2 + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Any Intensity` + [1] 6.0 0.6 + + $count_fraction_fixed_dp$MILD + [1] 2.0 0.2 + + $count_fraction_fixed_dp$MODERATE + [1] 2.0 0.2 + + $count_fraction_fixed_dp$SEVERE + [1] 2.0 0.2 + + # a_count_occurrences_by_grade works with healthy input. @@ -254,12 +385,17 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 Level: 1 2 (20%) 1 Level: 1 - 2 LVL 2 2 (20%) 2 LVL 2 - 3 Count of 3 2 (20%) 0 Count of 3 - 4 Missing 4 0 (0%) 3 Missing 4 - 5 5 0 (0%) 0 5 + row_name formatted_cell indent_mod row_label + 1 Level: 1 2 (20%) 1 Level: 1 + 2 LVL 2 2 (20%) 2 LVL 2 + 3 Count of 3 2 (20%) 0 Count of 3 + 4 Missing 4 0 (0%) 3 Missing 4 + 5 5 0 (0%) 0 5 + 6 Level: 1 2 (20%) 1 Level: 1 + 7 LVL 2 2 (20%) 2 LVL 2 + 8 Count of 3 2 (20%) 0 Count of 3 + 9 Missing 4 0 (0%) 3 Missing 4 + 10 5 0 (0%) 0 5 # count_occurrences_by_grade works with default arguments for intensity diff --git a/tests/testthat/_snaps/count_patients_events_in_cols.md b/tests/testthat/_snaps/count_patients_events_in_cols.md index 7a858a12e0..f8fb21f32b 100644 --- a/tests/testthat/_snaps/count_patients_events_in_cols.md +++ b/tests/testthat/_snaps/count_patients_events_in_cols.md @@ -14,12 +14,14 @@ [1] "counts" $serious - [1] 7 + count + 7 attr(,"label") [1] "counts" $fatal - [1] 4 + count + 4 attr(,"label") [1] "counts" @@ -45,7 +47,8 @@ [1] "counts" $fatal - [1] 4 + count + 4 attr(,"label") [1] "counts" diff --git a/tests/testthat/_snaps/count_patients_with_event.md b/tests/testthat/_snaps/count_patients_with_event.md index 2859584d29..f4b17a4601 100644 --- a/tests/testthat/_snaps/count_patients_with_event.md +++ b/tests/testthat/_snaps/count_patients_with_event.md @@ -4,16 +4,28 @@ res Output $n - [1] 2 + n + 2 $count - [1] 1 + count + 1 $count_fraction - [1] 1.0 0.5 + count fraction + 1.0 0.5 + + $count_fraction_fixed_dp + count fraction + 1.0 0.5 + + $fraction + num denom + 1 2 $n_blq - [1] 0 + n_blq + 0 # s_count_patients_with_event handles multiple columns @@ -22,16 +34,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 1 + count + 1 $count_fraction - [1] 1.0000000 0.3333333 + count fraction + 1.0000000 0.3333333 + + $count_fraction_fixed_dp + count fraction + 1.0000000 0.3333333 + + $fraction + num denom + 1 3 $n_blq - [1] 0 + n_blq + 0 # a_count_patients_with_event works with healthy input. @@ -41,12 +65,12 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 n 3 0 n - 2 count 1 0 count - 3 count_fraction 1 (33.3%) 0 count_fraction - 4 count_fraction_fixed_dp 1 (33.3%) 0 count_fraction - 5 n_blq 0 0 n_blq + row_name formatted_cell indent_mod row_label + 1 n 3 0 n + 2 count 1 0 count + 3 count_fraction 1 (33.3%) 0 count_fraction + 4 count_fraction_fixed_dp 1 (33.3%) 0 count_fraction_fixed_dp + 5 n_blq 0 0 n_blq # a_count_patients_with_event works with custom input. @@ -87,16 +111,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 1 + count + 1 $count_fraction - [1] 1.0000000 0.3333333 + count fraction + 1.0000000 0.3333333 + + $count_fraction_fixed_dp + count fraction + 1.0000000 0.3333333 + + $fraction + num denom + 1 3 $n_blq - [1] 0 + n_blq + 0 # count_patients_with_flags works as expected with risk difference column diff --git a/tests/testthat/_snaps/count_patients_with_flags.md b/tests/testthat/_snaps/count_patients_with_flags.md index 98f24e4342..ae1b1ab3ed 100644 --- a/tests/testthat/_snaps/count_patients_with_flags.md +++ b/tests/testthat/_snaps/count_patients_with_flags.md @@ -5,22 +5,38 @@ Output $n $n$TRTEMFL - [1] 2 + n + 2 $count $count$TRTEMFL - [1] 2 + count + 2 $count_fraction $count_fraction$TRTEMFL - [1] 2 1 + count fraction + 2 1 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp[[1]] + count fraction + 2 1 + + + $fraction + $fraction[[1]] + num denom + 2 2 $n_blq $n_blq[[1]] - [1] 0 + n_blq + 0 @@ -31,34 +47,62 @@ Output $n $n$TRTEMFL - [1] 3 + n + 3 $n$AEOUTFL - [1] 3 + n + 3 $count $count$TRTEMFL - [1] 3 + count + 3 $count$AEOUTFL - [1] 1 + count + 1 $count_fraction $count_fraction$TRTEMFL - [1] 3 1 + count fraction + 3 1 $count_fraction$AEOUTFL - [1] 1.0000000 0.3333333 + count fraction + 1.0000000 0.3333333 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$TRTEMFL + count fraction + 3 1 + + $count_fraction_fixed_dp$AEOUTFL + count fraction + 1.0000000 0.3333333 + + + $fraction + $fraction$TRTEMFL + num denom + 3 3 + + $fraction$AEOUTFL + num denom + 1 3 $n_blq $n_blq$TRTEMFL - [1] 0 + n_blq + 0 $n_blq$AEOUTFL - [1] 0 + n_blq + 0 @@ -69,58 +113,110 @@ Output $n $n$SER - [1] 164 + n + 164 $n$REL - [1] 164 + n + 164 $n$CTC35 - [1] 164 + n + 164 $n$CTC45 - [1] 164 + n + 164 $count $count$SER - [1] 128 + count + 128 $count$REL - [1] 137 + count + 137 $count$CTC35 - [1] 134 + count + 134 $count$CTC45 - [1] 104 + count + 104 $count_fraction $count_fraction$SER - [1] 128.0000000 0.7804878 + count fraction + 128.0000000 0.7804878 $count_fraction$REL - [1] 137.0000000 0.8353659 + count fraction + 137.0000000 0.8353659 $count_fraction$CTC35 - [1] 134.0000000 0.8170732 + count fraction + 134.0000000 0.8170732 $count_fraction$CTC45 - [1] 104.0000000 0.6341463 + count fraction + 104.0000000 0.6341463 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$SER + count fraction + 128.0000000 0.7804878 + + $count_fraction_fixed_dp$REL + count fraction + 137.0000000 0.8353659 + + $count_fraction_fixed_dp$CTC35 + count fraction + 134.0000000 0.8170732 + + $count_fraction_fixed_dp$CTC45 + count fraction + 104.0000000 0.6341463 + + + $fraction + $fraction$SER + num denom + 128 164 + + $fraction$REL + num denom + 137 164 + + $fraction$CTC35 + num denom + 134 164 + + $fraction$CTC45 + num denom + 104 164 $n_blq $n_blq$SER - [1] 0 + n_blq + 0 $n_blq$REL - [1] 0 + n_blq + 0 $n_blq$CTC35 - [1] 0 + n_blq + 0 $n_blq$CTC45 - [1] 0 + n_blq + 0 @@ -131,58 +227,110 @@ Output $n $n$`Serious AE` - [1] 164 + n + 164 $n$`Related AE` - [1] 164 + n + 164 $n$`Grade 3-5 AE` - [1] 164 + n + 164 $n$`Grade 4/5 AE` - [1] 164 + n + 164 $count $count$`Serious AE` - [1] 128 + count + 128 $count$`Related AE` - [1] 137 + count + 137 $count$`Grade 3-5 AE` - [1] 134 + count + 134 $count$`Grade 4/5 AE` - [1] 104 + count + 104 $count_fraction $count_fraction$`Serious AE` - [1] 128.0000000 0.7804878 + count fraction + 128.0000000 0.7804878 $count_fraction$`Related AE` - [1] 137.0000000 0.8353659 + count fraction + 137.0000000 0.8353659 $count_fraction$`Grade 3-5 AE` - [1] 134.0000000 0.8170732 + count fraction + 134.0000000 0.8170732 $count_fraction$`Grade 4/5 AE` - [1] 104.0000000 0.6341463 + count fraction + 104.0000000 0.6341463 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Serious AE` + count fraction + 128.0000000 0.7804878 + + $count_fraction_fixed_dp$`Related AE` + count fraction + 137.0000000 0.8353659 + + $count_fraction_fixed_dp$`Grade 3-5 AE` + count fraction + 134.0000000 0.8170732 + + $count_fraction_fixed_dp$`Grade 4/5 AE` + count fraction + 104.0000000 0.6341463 + + + $fraction + $fraction$`Serious AE` + num denom + 128 164 + + $fraction$`Related AE` + num denom + 137 164 + + $fraction$`Grade 3-5 AE` + num denom + 134 164 + + $fraction$`Grade 4/5 AE` + num denom + 104 164 $n_blq $n_blq$`Serious AE` - [1] 0 + n_blq + 0 $n_blq$`Related AE` - [1] 0 + n_blq + 0 $n_blq$`Grade 3-5 AE` - [1] 0 + n_blq + 0 $n_blq$`Grade 4/5 AE` - [1] 0 + n_blq + 0 @@ -193,58 +341,110 @@ Output $n $n$`Category 1` - [1] 164 + n + 164 $n$`Category 2` - [1] 164 + n + 164 $n$`Category 3` - [1] 164 + n + 164 $n$`Category 4` - [1] 164 + n + 164 $count $count$`Category 1` - [1] 128 + count + 128 $count$`Category 2` - [1] 137 + count + 137 $count$`Category 3` - [1] 134 + count + 134 $count$`Category 4` - [1] 104 + count + 104 $count_fraction $count_fraction$`Category 1` - [1] 128.0000000 0.7804878 + count fraction + 128.0000000 0.7804878 $count_fraction$`Category 2` - [1] 137.0000000 0.8353659 + count fraction + 137.0000000 0.8353659 $count_fraction$`Category 3` - [1] 134.0000000 0.8170732 + count fraction + 134.0000000 0.8170732 $count_fraction$`Category 4` - [1] 104.0000000 0.6341463 + count fraction + 104.0000000 0.6341463 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Category 1` + count fraction + 128.0000000 0.7804878 + + $count_fraction_fixed_dp$`Category 2` + count fraction + 137.0000000 0.8353659 + + $count_fraction_fixed_dp$`Category 3` + count fraction + 134.0000000 0.8170732 + + $count_fraction_fixed_dp$`Category 4` + count fraction + 104.0000000 0.6341463 + + + $fraction + $fraction$`Category 1` + num denom + 128 164 + + $fraction$`Category 2` + num denom + 137 164 + + $fraction$`Category 3` + num denom + 134 164 + + $fraction$`Category 4` + num denom + 104 164 $n_blq $n_blq$`Category 1` - [1] 0 + n_blq + 0 $n_blq$`Category 2` - [1] 0 + n_blq + 0 $n_blq$`Category 3` - [1] 0 + n_blq + 0 $n_blq$`Category 4` - [1] 0 + n_blq + 0 @@ -255,58 +455,110 @@ Output $n $n$`Serious AE` - [1] 164 + n + 164 $n$`Related AE` - [1] 164 + n + 164 $n$`Grade 3-5 AE` - [1] 164 + n + 164 $n$`Grade 4/5 AE` - [1] 164 + n + 164 $count $count$`Serious AE` - [1] 128 + count + 128 $count$`Related AE` - [1] 137 + count + 137 $count$`Grade 3-5 AE` - [1] 134 + count + 134 $count$`Grade 4/5 AE` - [1] 104 + count + 104 $count_fraction $count_fraction$`Serious AE` - [1] 128.0000000 0.7804878 + count fraction + 128.0000000 0.7804878 $count_fraction$`Related AE` - [1] 137.0000000 0.8353659 + count fraction + 137.0000000 0.8353659 $count_fraction$`Grade 3-5 AE` - [1] 134.0000000 0.8170732 + count fraction + 134.0000000 0.8170732 $count_fraction$`Grade 4/5 AE` - [1] 104.0000000 0.6341463 + count fraction + 104.0000000 0.6341463 + + + $count_fraction_fixed_dp + $count_fraction_fixed_dp$`Serious AE` + count fraction + 128.0000000 0.7804878 + + $count_fraction_fixed_dp$`Related AE` + count fraction + 137.0000000 0.8353659 + + $count_fraction_fixed_dp$`Grade 3-5 AE` + count fraction + 134.0000000 0.8170732 + + $count_fraction_fixed_dp$`Grade 4/5 AE` + count fraction + 104.0000000 0.6341463 + + + $fraction + $fraction$`Serious AE` + num denom + 128 164 + + $fraction$`Related AE` + num denom + 137 164 + + $fraction$`Grade 3-5 AE` + num denom + 134 164 + + $fraction$`Grade 4/5 AE` + num denom + 104 164 $n_blq $n_blq$`Serious AE` - [1] 0 + n_blq + 0 $n_blq$`Related AE` - [1] 0 + n_blq + 0 $n_blq$`Grade 3-5 AE` - [1] 0 + n_blq + 0 $n_blq$`Grade 4/5 AE` - [1] 0 + n_blq + 0 @@ -347,10 +599,10 @@ RowsVerticalSection (in_rows) object print method: ---------------------------- row_name formatted_cell indent_mod row_label - 1 count_fraction.SER 128 (78.05%) 2 New label + 1 count_fraction.SER 128 (78.05%) 2 Serious AE 2 count_fraction.REL 137 (83.54%) 3 Related AE - 3 count_fraction.CTC35 134 (81.71%) 1 Grade 3-5 AE - 4 count_fraction.CTC45 104 (63.41%) 1 Grade 4/5 AE + 3 count_fraction.CTC35 134 (81.71%) 0 Grade 3-5 AE + 4 count_fraction.CTC45 104 (63.41%) 0 Grade 4/5 AE # count_patients_with_flags works as expected diff --git a/tests/testthat/_snaps/count_values.md b/tests/testthat/_snaps/count_values.md index 8ba7374b6c..a23e0de1bb 100644 --- a/tests/testthat/_snaps/count_values.md +++ b/tests/testthat/_snaps/count_values.md @@ -4,16 +4,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0000000 0.6666667 + count fraction + 2.0000000 0.6666667 + + $count_fraction_fixed_dp + count fraction + 2.0000000 0.6666667 + + $fraction + num denom + 2 3 $n_blq - [1] 0 + n_blq + 0 --- @@ -22,16 +34,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 0 + count + 0 $count_fraction - [1] 0 0 + count fraction + 0 0 + + $count_fraction_fixed_dp + count fraction + 0 0 + + $fraction + num denom + 0 3 $n_blq - [1] 0 + n_blq + 0 # s_count_values works for character input with NAs @@ -40,16 +64,28 @@ res Output $n - [1] 5 + n + 5 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0 0.4 + count fraction + 2.0 0.4 + + $count_fraction_fixed_dp + count fraction + 2.0 0.4 + + $fraction + num denom + 2 5 $n_blq - [1] 0 + n_blq + 0 --- @@ -58,16 +94,28 @@ res Output $n - [1] 6 + n + 6 $count - [1] 1 + count + 1 $count_fraction - [1] 1.0000000 0.1666667 + count fraction + 1.0000000 0.1666667 + + $count_fraction_fixed_dp + count fraction + 1.0000000 0.1666667 + + $fraction + num denom + 1 6 $n_blq - [1] 0 + n_blq + 0 # s_count_values can pass options to s_summary's logical method @@ -76,16 +124,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0 0.2 + count fraction + 2.0 0.2 + + $count_fraction_fixed_dp + count fraction + 2.0 0.2 + + $fraction + num denom + 2 10 $n_blq - [1] 0 + n_blq + 0 # s_count_values for factor gives same result as for character @@ -94,16 +154,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0 0.2 + count fraction + 2.0 0.2 + + $count_fraction_fixed_dp + count fraction + 2.0 0.2 + + $fraction + num denom + 2 10 $n_blq - [1] 0 + n_blq + 0 # s_count_values for factor gives the same result as for character for values not in factor level @@ -112,16 +184,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 0 + count + 0 $count_fraction - [1] 0 0 + count fraction + 0 0 + + $count_fraction_fixed_dp + count fraction + 0 0 + + $fraction + num denom + 0 3 $n_blq - [1] 0 + n_blq + 0 # count_values works as expected with a single value @@ -160,16 +244,28 @@ res Output $n - [1] 3 + n + 3 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0000000 0.6666667 + count fraction + 2.0000000 0.6666667 + + $count_fraction_fixed_dp + count fraction + 2.0000000 0.6666667 + + $fraction + num denom + 2 3 $n_blq - [1] 0 + n_blq + 0 # s_count_values for logical vector with NA @@ -178,15 +274,27 @@ res Output $n - [1] 3 + n + 3 $count - [1] 2 + count + 2 $count_fraction - [1] 2.0000000 0.6666667 + count fraction + 2.0000000 0.6666667 + + $count_fraction_fixed_dp + count fraction + 2.0000000 0.6666667 + + $fraction + num denom + 2 3 $n_blq - [1] 0 + n_blq + 0 diff --git a/tests/testthat/_snaps/rtables_access.md b/tests/testthat/_snaps/rtables_access.md index ae3e587bab..8c918a8782 100644 --- a/tests/testthat/_snaps/rtables_access.md +++ b/tests/testthat/_snaps/rtables_access.md @@ -78,8 +78,8 @@ Code res Output - B: Placebo C: Combination - 0.20000000 0.03225806 + B: Placebo.p C: Combination.p + 0.20000000 0.03225806 # h_col_counts works as expected diff --git a/tests/testthat/_snaps/utils_default_stats_formats_labels.md b/tests/testthat/_snaps/utils_default_stats_formats_labels.md index aa5850acc1..c36e3c937a 100644 --- a/tests/testthat/_snaps/utils_default_stats_formats_labels.md +++ b/tests/testthat/_snaps/utils_default_stats_formats_labels.md @@ -40,10 +40,10 @@ Code res Output - count count_fraction count_fraction_fixed_dp - "count" "count_fraction" "count_fraction" - fraction - "fraction" + count count_fraction count_fraction_fixed_dp + "count" "count_fraction" "count_fraction_fixed_dp" + fraction + "fraction" # get_indents_from_stats works as expected @@ -145,7 +145,7 @@ n count "n" "count" count_fraction count_fraction_fixed_dp - "count_fraction" "count_fraction" + "count_fraction" "count_fraction_fixed_dp" fraction n_blq "fraction" "n_blq" pval_counts diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 712205d9bb..a8aded8593 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -22,9 +22,10 @@ skip_if_too_deep <- function(depth) { } # expect_snapshot_ggplot - set custom plot dimensions -expect_snapshot_ggplot <- function(title, fig, width = NA, height = NA) { +expect_snapshot_ggplot <- function(title, fig, width = NA, height = NA, no_plot_snapshots = TRUE) { testthat::skip_on_ci() testthat::skip_if_not_installed("svglite") + testthat::skip_if(no_plot_snapshots) name <- paste0(title, ".svg") path <- tempdir() diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 9940e36c3e..a258f84a17 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -10,14 +10,14 @@ testthat::test_that("s_summary return NA for x length 0L", { testthat::test_that("s_summary handles NA", { x <- c(NA_real_, 1) - # With `na.rm = TRUE`. + # With `na_rm = TRUE`. result <- s_summary(x) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) - # With `na.rm = FALSE`. - result <- s_summary(x, na.rm = FALSE) + # With `na_rm = FALSE`. + result <- s_summary(x, na_rm = FALSE) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) @@ -56,7 +56,7 @@ testthat::test_that("s_summary fails with factors that have no levels or have em testthat::test_that("s_summary works when factors have NA levels", { x <- factor(c("Female", "Male", "Female", "Male", "Unknown", "Unknown", NA)) - result <- s_summary(x, na.rm = FALSE) + result <- s_summary(x, na_rm = FALSE) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) @@ -107,7 +107,7 @@ testthat::test_that("s_summary works with characters by converting to character" testthat::test_that("s_summary works with characters by converting to character and handling empty strings", { x <- c("Female", "Male", "Female", "Male", "Male", "", "Unknown", "Unknown", "Unknown", "Unknown") - testthat::expect_warning(result <- s_summary(x, .var = "foo", na.rm = FALSE, denom = "N_row", .N_row = 10)) + testthat::expect_warning(result <- s_summary(x, .var = "foo", na_rm = FALSE, denom = "N_row", .N_row = 10)) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) @@ -146,12 +146,13 @@ testthat::test_that("s_summary works with logical vectors and by default removes testthat::test_that("s_summary works with logical vectors and by if requested does not remove NA from n", { x <- c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, NA, NA) - result <- s_summary(x, na.rm = FALSE) + result <- s_summary(x, na_rm = FALSE) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) +# a_summary -------------------------------------------------------------------- testthat::test_that("a_summary work with healthy input.", { options("width" = 100) @@ -160,12 +161,12 @@ testthat::test_that("a_summary work with healthy input.", { x <- rnorm(10) result <- a_summary( x = x, .N_col = 10, .N_row = 20, .var = "bla", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, - compare = FALSE, .stats = get_stats("analyze_vars_numeric"), na.rm = TRUE, na_str = default_na_str() + compare_with_ref_group = FALSE, .stats = get_stats("analyze_vars_numeric"), na_rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) # numeric input - a_summary - result <- a_summary(x = x, .N_col = 10, .N_row = 10, .var = "bla") + result <- a_summary(x = x, .N_col = 10, .N_row = 10, .var = "bla", compare_with_ref_group = FALSE) res <- testthat::expect_silent(result) testthat::expect_identical(res_out, res) testthat::expect_snapshot(res) @@ -174,13 +175,13 @@ testthat::test_that("a_summary work with healthy input.", { x <- factor(c("a", "a", "b", "c", "a")) result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = "bla", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, - compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = default_na_str() + compare_with_ref_group = FALSE, .stats = get_stats("analyze_vars_counts"), + na_rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) # factor input - a_summary - result <- a_summary(x = x, .N_row = 10, .N_col = 10) + result <- a_summary(x = x, .N_row = 10, .N_col = 10, compare_with_ref_group = FALSE) res <- testthat::expect_silent(result) testthat::expect_identical(res_out, res) testthat::expect_snapshot(res) @@ -189,14 +190,14 @@ testthat::test_that("a_summary work with healthy input.", { x <- c("A", "B", "A", "C") result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = "x", .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, - compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = default_na_str(), + compare_with_ref_group = FALSE, .stats = get_stats("analyze_vars_counts"), + na_rm = TRUE, na_str = default_na_str(), verbose = FALSE ) res_out <- testthat::expect_silent(result) # character input - a_summary - result <- a_summary(x = x, .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE) + result <- a_summary(x = x, .var = "x", .N_col = 10, .N_row = 10, verbose = FALSE, compare_with_ref_group = FALSE) res <- testthat::expect_silent(result) testthat::expect_identical(res_out, res) testthat::expect_snapshot(res) @@ -205,13 +206,13 @@ testthat::test_that("a_summary work with healthy input.", { x <- c(TRUE, FALSE, FALSE, TRUE, TRUE) result <- a_summary( x = x, .N_col = 10, .N_row = 10, .var = NULL, .df_row = NULL, .ref_group = NULL, .in_ref_col = FALSE, - compare = FALSE, .stats = get_stats("analyze_vars_counts"), - na.rm = TRUE, na_str = default_na_str() + compare_with_ref_group = FALSE, .stats = get_stats("analyze_vars_counts"), + na_rm = TRUE, na_str = default_na_str() ) res_out <- testthat::expect_silent(result) # logical input - a_summary - result <- a_summary(x = x, .N_row = 10, .N_col = 10) + result <- a_summary(x = x, .N_row = 10, .N_col = 10, compare_with_ref_group = FALSE) res <- testthat::expect_silent(result) testthat::expect_identical(res_out, res) testthat::expect_snapshot(res) @@ -219,9 +220,12 @@ testthat::test_that("a_summary work with healthy input.", { testthat::test_that("a_summary works with custom input.", { options("width" = 100) + + set.seed(1) result <- a_summary( rnorm(10), - .N_col = 10, .N_row = 20, control_analyze_vars(conf_level = 0.90), .stats = c("sd", "median_ci"), + .N_col = 10, .N_row = 20, compare_with_ref_group = FALSE, + control = control_analyze_vars(conf_level = 0.90), .stats = c("sd", "median_ci"), .formats = c(sd = "xx.", median_ci = "xx.xx - xx.xx"), .labels = c(sd = "std. dev"), .indent_mods = 3L ) res <- testthat::expect_silent(result) @@ -229,47 +233,61 @@ testthat::test_that("a_summary works with custom input.", { result <- a_summary( factor(c("a", "a", "b", "c", NA)), + compare_with_ref_group = FALSE, .N_row = 10, .N_col = 10, .formats = c(n = "xx.xx"), - .labels = c(n = "number of records"), .indent_mods = c(n = -1L, count = 5L), na.rm = FALSE + .labels = c(n = "number of records"), .indent_mods = c(n = -1L, count = 5L), na_rm = FALSE ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) -testthat::test_that("a_summary works with healthy input when compare = TRUE.", { +testthat::test_that("a_summary works with healthy input when compare_with_ref_group = TRUE.", { options("width" = 100) # numeric input set.seed(1) - result <- a_summary(rnorm(10, 5, 1), .ref_group = rnorm(20, -5, 1), .var = "bla", compare = TRUE) + result <- a_summary(rnorm(10, 5, 1), + .ref_group = rnorm(20, -5, 1), .var = "bla", + compare_with_ref_group = TRUE, .in_ref_col = FALSE + ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) # factor input result <- a_summary( factor(c("a", "a", "b", "c", "a")), - .ref_group = factor(c("a", "a", "b", "c")), compare = TRUE + .ref_group = factor(c("a", "a", "b", "c")), + compare_with_ref_group = TRUE, .in_ref_col = FALSE ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) # character input - result <- a_summary(c("A", "B", "A", "C"), .ref_group = c("B", "A", "C"), .var = "x", compare = TRUE, verbose = FALSE) + result <- a_summary(c("A", "B", "A", "C"), + .ref_group = c("B", "A", "C"), + .var = "x", compare_with_ref_group = TRUE, .in_ref_col = FALSE, + verbose = FALSE + ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) # logical input - result <- a_summary(c(TRUE, FALSE, FALSE, TRUE, TRUE), .ref_group = c(TRUE, FALSE), compare = TRUE) + result <- a_summary(c(TRUE, FALSE, FALSE, TRUE, TRUE), + .ref_group = c(TRUE, FALSE), compare_with_ref_group = TRUE, + .in_ref_col = FALSE + ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) -testthat::test_that("a_summary works with custom input when compare = TRUE.", { +testthat::test_that("a_summary works with custom input when compare_with_ref_group = TRUE.", { options("width" = 100) + + set.seed(1) result <- a_summary( rnorm(10), .ref_group = rnorm(20, -5, 1), .N_col = 10, .N_row = 20, control_analyze_vars(conf_level = 0.90), .stats = c("pval", "median_ci"), .formats = c(median_ci = "xx.xx - xx.xx"), .labels = c(pval = "pvalue"), - .indent_mods = 3L, compare = TRUE + .indent_mods = 3L, compare_with_ref_group = TRUE, .in_ref_col = FALSE ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) @@ -278,13 +296,13 @@ testthat::test_that("a_summary works with custom input when compare = TRUE.", { factor(c("a", "a", "b", "c", NA)), .ref_group = factor(c("a", "a", "b", "c")), .N_row = 10, .N_col = 10, .formats = c(n = "xx.xx"), .labels = c(n = "number of records"), .indent_mods = c(n = -1L, count = 5L), - na.rm = FALSE, compare = TRUE + na_rm = FALSE, compare_with_ref_group = TRUE, .in_ref_col = FALSE ) res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) -testthat::test_that("`analyze_vars` works with healthy input, default `na.rm = TRUE`.", { +testthat::test_that("`analyze_vars` works with healthy input, default `na_rm = TRUE`.", { dta_test <- data.frame(AVAL = c(1:4, NA, NA)) l <- basic_table() %>% @@ -310,11 +328,11 @@ testthat::test_that("`analyze_vars` works with healthy input, and control functi testthat::expect_snapshot(res) }) -testthat::test_that("`analyze_vars` works with healthy input, alternative `na.rm = FALSE`", { +testthat::test_that("`analyze_vars` works with healthy input, alternative `na_rm = FALSE`", { dta_test <- data.frame(AVAL = c(1:4, NA, NA)) l <- basic_table() %>% - analyze_vars(vars = "AVAL", na.rm = FALSE) + analyze_vars(vars = "AVAL", na_rm = FALSE) result <- build_table(l, df = dta_test) res <- testthat::expect_silent(result) @@ -332,11 +350,11 @@ testthat::test_that("`analyze_vars` works with healthy factor input", { testthat::expect_snapshot(res) }) -testthat::test_that("`analyze_vars` works with healthy factor input, alternative `na.rm = FALSE`", { +testthat::test_that("`analyze_vars` works with healthy factor input, alternative `na_rm = FALSE`", { dta <- data.frame(foo = factor(c("a", NA, "b", "a", NA))) result <- basic_table() %>% - analyze_vars(vars = "foo", na.rm = FALSE) %>% + analyze_vars(vars = "foo", na_rm = FALSE) %>% build_table(dta) res <- testthat::expect_silent(result) @@ -345,7 +363,7 @@ testthat::test_that("`analyze_vars` works with healthy factor input, alternative dta <- df_explicit_na(dta) result <- basic_table() %>% - analyze_vars(vars = "foo", na.rm = FALSE) %>% + analyze_vars(vars = "foo", na_rm = FALSE) %>% build_table(dta) res <- testthat::expect_silent(result) @@ -437,11 +455,11 @@ testthat::test_that("`analyze_vars` works with logical input", { testthat::expect_snapshot(res) }) -testthat::test_that("`analyze_vars` works with healthy logical input, alternative `na.rm = FALSE`", { +testthat::test_that("`analyze_vars` works with healthy logical input, alternative `na_rm = FALSE`", { dta <- data.frame(foo = factor(c(TRUE, NA, FALSE, TRUE, NA))) result <- basic_table() %>% - analyze_vars(vars = "foo", na.rm = FALSE) %>% + analyze_vars(vars = "foo", na_rm = FALSE) %>% build_table(dta) res <- testthat::expect_silent(result) @@ -450,7 +468,7 @@ testthat::test_that("`analyze_vars` works with healthy logical input, alternativ dta <- df_explicit_na(dta) result <- basic_table() %>% - analyze_vars(vars = "foo", na.rm = FALSE) %>% + analyze_vars(vars = "foo", na_rm = FALSE) %>% build_table(dta) res <- testthat::expect_silent(result) @@ -520,3 +538,85 @@ testthat::test_that("analyze_vars works correctly with auto formats", { result <- testthat::expect_silent(res) testthat::expect_snapshot(res) }) + +testthat::test_that("analyze_vars works well with additional stat names (.stat_names_in)", { + dt <- data.frame("VAR" = c(0.001, 0.2, 0.0011000, 3, 4)) + res <- basic_table() %>% + analyze_vars( + vars = "VAR", + .stats = c("n", "mean", "mean_sd", "range"), + .stat_names_in = list("n" = "CoUnT"), + .formats = c("mean_sd" = "auto", "range" = "auto") + ) %>% + build_table(dt) %>% + as_result_df(make_ard = TRUE) + + testthat::expect_equal(res$stat_name, c("CoUnT", "mean", "mean", "sd", "min", "max")) +}) + +testthat::test_that("analyze_vars works well with additional stat names (.stat_names_in) and stats (custom fnc)", { + dt <- data.frame("VAR" = c(0.001, 0.2, 0.0011000, 3, 4), "VAR2" = letters[seq(5)]) + res <- basic_table() %>% + analyze_vars( + vars = c("VAR", "VAR2"), + .stats = c("n", "mean", + "a" = function(x, ...) { + return(0) + }, + "v" = function(x, ...) { + return(0) + } + ), + .stat_names_in = list("n" = "CoUnT", "v" = "something"), + .formats = c("mean" = "auto", "v" = "xx.xx"), + verbose = FALSE # now it works + ) %>% + build_table(dt) + + res2 <- res %>% + as_result_df(make_ard = TRUE) + + # stat_names are correctly assigned + testthat::expect_equal( + res2$stat_name, + c("CoUnT", "mean", NA, "something", "n", NA, "something") + ) + + # format for v is correctly printed (added external statistic) + testthat::expect_equal( + as_result_df(res, data_format = "strings")[nrow(res2), ncol(res2)], + c("0.00") # i.e. x.xx + ) +}) +testthat::test_that("analyze_vars works well with additional stat names (.stat_names_in) and stats (custom fnc)", { + dt <- data.frame("VAR" = c(0.001, 0.2, 0.0011000, 3, 4), "VAR2" = letters[seq(5)]) + res <- basic_table() %>% + analyze_vars( + vars = c("VAR", "VAR2"), + .stats = c("n", "mean", "count_fraction", + "a_zero" = function(x, ...) { + return(0) + } + ), + .stat_names_in = list("n" = "CoUnT", "v" = "something"), + .formats = c("mean" = "auto", "v" = "xx.xx"), + .labels = list("n" = "N=", "a" = "AAAA", "a_zero" = "A_ZERO"), + verbose = FALSE # now it works + ) %>% + build_table(dt) + + testthat::expect_equal( + matrix_form(res)$strings[, 1], + c("", "VAR", "N=", "Mean", "A_ZERO", "VAR2", "N=", "AAAA", "b", "c", "d", "e", "A_ZERO") + ) + + res2 <- res %>% + as_result_df(make_ard = TRUE) + + # stat_names are correctly assigned + cols_int <- names(res2) %in% c("variable", "variable_level", "variable_label", "stat_name", "stat") + testthat::expect_equal( + unlist(res2[nrow(res2), cols_int, drop = TRUE], use.names = FALSE), + c("VAR2", "a_zero.a_zero", "A_ZERO", NA, 0) + ) +}) diff --git a/tests/testthat/test-compare_variables.R b/tests/testthat/test-compare_variables.R index 7a5d44f298..6028a150c3 100644 --- a/tests/testthat/test-compare_variables.R +++ b/tests/testthat/test-compare_variables.R @@ -40,7 +40,7 @@ testthat::test_that("s_compare for factor handles explicit NAs as expected", { x = x, .ref_group = y, .in_ref_col = FALSE, - na.rm = TRUE + na_rm = TRUE )) res <- testthat::expect_silent(result_without_na$pval_counts) @@ -50,7 +50,7 @@ testthat::test_that("s_compare for factor handles explicit NAs as expected", { x = x, .ref_group = y, .in_ref_col = FALSE, - na.rm = FALSE + na_rm = FALSE )) res <- testthat::expect_silent(result_with_na$pval_counts) @@ -81,7 +81,7 @@ testthat::test_that("s_compare for logical works as expected", { testthat::test_that("s_compare for logical handles NAs as FALSE if not removed", { x <- c(NA, TRUE, FALSE) y <- c(NA, NA, NA, NA, FALSE) - result <- testthat::expect_silent(s_compare(x, .ref_group = y, .in_ref_col = FALSE, na.rm = FALSE)) + result <- testthat::expect_silent(s_compare(x, .ref_group = y, .in_ref_col = FALSE, na_rm = FALSE)) expected <- s_compare( x = replace(x, is.na(x), FALSE), .ref_group = replace(y, is.na(y), FALSE), diff --git a/tests/testthat/test-count_occurrences_by_grade.R b/tests/testthat/test-count_occurrences_by_grade.R index 7f5b09bfdc..b60cf99373 100644 --- a/tests/testthat/test-count_occurrences_by_grade.R +++ b/tests/testthat/test-count_occurrences_by_grade.R @@ -154,8 +154,8 @@ testthat::test_that("a_count_occurrences_by_grade works with custom input.", { df = raw_data, .N_col = 10, .N_row = 10, .df_row = raw_data, .stats = "count_fraction", .formats = c(count_fraction = "xx (xx%)"), - .labels = list("1" = "Level: 1", "2" = "LVL 2", "count_fraction.3" = "Count of 3", "4" = "Missing 4"), - .indent_mods = list("1" = 1L, "2" = 2L, "count_fraction.4" = 3L), + .labels = list("1" = "Level: 1", "2" = "LVL 2", "3" = "Count of 3", "4" = "Missing 4"), + .indent_mods = list("1" = 1L, "2" = 2L, "4" = 3L), .var = "AETOXGR", id = "USUBJID" ) diff --git a/tests/testthat/test-count_patients_with_event.R b/tests/testthat/test-count_patients_with_event.R index aeffa45229..1f9a9ea12d 100644 --- a/tests/testthat/test-count_patients_with_event.R +++ b/tests/testthat/test-count_patients_with_event.R @@ -7,7 +7,9 @@ testthat::test_that("s_count_patients_with_event handles NA", { result <- s_count_patients_with_event( test_data, .var = "SUBJID", - filters = c("TRTEMFL" = "Y") + filters = c("TRTEMFL" = "Y"), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -24,7 +26,9 @@ testthat::test_that("s_count_patients_with_event handles multiple columns", { result <- s_count_patients_with_event( test_data, .var = "SUBJID", - filters = c("TRTEMFL" = "Y", "AEOUT" = "FATAL") + filters = c("TRTEMFL" = "Y", "AEOUT" = "FATAL"), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -159,7 +163,9 @@ testthat::test_that("s_count_patients_with_event works with factor filters", { result <- s_count_patients_with_event( test_data, .var = "SUBJID", - filters = c("AEOUT" = "FATAL") + filters = c("AEOUT" = "FATAL"), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) diff --git a/tests/testthat/test-count_patients_with_flags.R b/tests/testthat/test-count_patients_with_flags.R index 2c615fe4c3..60f8744201 100644 --- a/tests/testthat/test-count_patients_with_flags.R +++ b/tests/testthat/test-count_patients_with_flags.R @@ -7,7 +7,9 @@ testthat::test_that("s_count_patients_with_flags handles NA", { result <- s_count_patients_with_flags( test_data, .var = "SUBJID", - flag_variables = "TRTEMFL" + flag_variables = "TRTEMFL", + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -24,7 +26,9 @@ testthat::test_that("s_count_patients_with_flags handles multiple columns", { result <- s_count_patients_with_flags( test_data, .var = "SUBJID", - flag_variables = c("TRTEMFL", "AEOUTFL") + flag_variables = c("TRTEMFL", "AEOUTFL"), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -32,7 +36,7 @@ testthat::test_that("s_count_patients_with_flags handles multiple columns", { }) testthat::test_that("s_count_patients_with_flags custom variable label behaviour works", { - adae_local <- tern_ex_adae %>% + test_data <- tern_ex_adae %>% dplyr::mutate( SER = AESER == "Y", REL = AEREL == "Y", @@ -43,9 +47,11 @@ testthat::test_that("s_count_patients_with_flags custom variable label behaviour # No variable labels (variable names used) result <- s_count_patients_with_flags( - adae_local, + test_data, .var = "USUBJID", - flag_variables = aesi_vars + flag_variables = aesi_vars, + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -53,14 +59,16 @@ testthat::test_that("s_count_patients_with_flags custom variable label behaviour labels <- c("Serious AE", "Related AE", "Grade 3-5 AE", "Grade 4/5 AE") for (i in seq_along(aesi_vars)) { - attr(adae_local[[aesi_vars[i]]], "label") <- labels[i] + attr(test_data[[aesi_vars[i]]], "label") <- labels[i] } # Variable labels from df result <- s_count_patients_with_flags( - adae_local, + test_data, .var = "USUBJID", - flag_variables = aesi_vars + flag_variables = aesi_vars, + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -68,10 +76,12 @@ testthat::test_that("s_count_patients_with_flags custom variable label behaviour # Custom labels via flag_labels argument result <- s_count_patients_with_flags( - adae_local, + test_data, .var = "USUBJID", flag_variables = aesi_vars, - flag_labels = c("Category 1", "Category 2", "Category 3", "Category 4") + flag_labels = c("Category 1", "Category 2", "Category 3", "Category 4"), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) @@ -79,9 +89,11 @@ testthat::test_that("s_count_patients_with_flags custom variable label behaviour # Labels supplied within flag_variables argument result <- s_count_patients_with_flags( - adae_local, + test_data, .var = "USUBJID", - flag_variables = formatters::var_labels(adae_local[, aesi_vars]) + flag_variables = formatters::var_labels(test_data[, aesi_vars]), + .N_col = ncol(test_data), + .N_row = nrow(test_data) ) res <- testthat::expect_silent(result) diff --git a/tests/testthat/test-g_lineplot.R b/tests/testthat/test-g_lineplot.R index b25cf60228..6df7b2ee16 100644 --- a/tests/testthat/test-g_lineplot.R +++ b/tests/testthat/test-g_lineplot.R @@ -143,10 +143,10 @@ testthat::test_that("control_lineplot_vars works", { }) testthat::test_that("g_lineplot works with no strata (group_var) and allows points when only one strata is provided", { - adlb2 <- adlb |> + adlb2 <- adlb %>% dplyr::filter(USUBJID == "AB12345-BRA-1-id-105") - adsl2 <- adsl |> + adsl2 <- adsl %>% dplyr::filter(USUBJID == "AB12345-BRA-1-id-105") g_lineplot_no_strata <- withr::with_options( diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index 05ac191ef3..a52a41484a 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -207,24 +207,24 @@ testthat::test_that("summarize_ancova works with irregular arm levels", { res <- testthat::expect_silent(result2) testthat::expect_snapshot(res) - adsl <- adsl |> + adsl <- adsl %>% mutate( ARMCD = case_match( ARMCD, "ARM A" ~ "10mg/kg", "ARM B" ~ "20mg/kg", "ARM C" ~ "30mg/kg" - ) |> factor(levels = paste0(1:3, "0mg/kg")), + ) %>% factor(levels = paste0(1:3, "0mg/kg")), ) - result3 <- basic_table() |> - split_cols_by("ARMCD", ref_group = "10mg/kg") |> + result3 <- basic_table() %>% + split_cols_by("ARMCD", ref_group = "10mg/kg") %>% summarize_ancova( vars = "BMRKR1", variables = list(arm = "ARMCD"), conf_level = 0.95, var_labels = "ARMCD" - ) |> + ) %>% build_table(adsl) res <- testthat::expect_silent(result3) diff --git a/tests/testthat/test-utils_default_stats_formats_labels.R b/tests/testthat/test-utils_default_stats_formats_labels.R index 9583faac18..b03c0c7f81 100644 --- a/tests/testthat/test-utils_default_stats_formats_labels.R +++ b/tests/testthat/test-utils_default_stats_formats_labels.R @@ -138,17 +138,61 @@ testthat::test_that("get_labels_from_stats works as expected", { ), stats_to_do ) +}) - # with row_nms - testthat::expect_identical( +testthat::test_that("get_labels_from_stats with labels in works when adding levels to stats", { + labels_custom <- c("c" = "Lvl c:", "a" = "CF: A", "count" = "COUNT", "count_fraction.b" = "notB") + levels_per_stats <- list( + count = c("a", "b", "c"), + count_fraction = c("a", "b", "c") + ) + + # with levels_per_stats + testthat::expect_equal( get_labels_from_stats( stats = c("count", "count_fraction"), - labels_in = c("c" = "Lvl c:", "count_fraction.a" = "CF: A", "count.b" = "Count of b"), - row_nms = c("a", "b", "c") + labels_in = labels_custom, + levels_per_stats = levels_per_stats + ), + list( + count = c("a" = "CF: A", "b" = "COUNT", "c" = "Lvl c:"), + count_fraction = c("a" = "CF: A", "b" = "notB", "c" = "Lvl c:") + ) + ) +}) + + +testthat::test_that("get_labels_from_stats works fine for cases with levels", { + x_stats <- list( + n = list( + n = c(n = 5) ), + count_fraction = list( + a = c(count = 1.0, p = 0.2), + b = c(count = 1.0, p = 0.2), + c = c(count = 1.0, p = 0.2), + d = c(count = 1.0, p = 0.2), + e = c(count = 1.0, p = 0.2) + ), + a_zero = 0, + a_null = NULL + ) + .stats <- names(x_stats) + .labels <- list("n" = "N=", "a" = "AAAA", "a_zero" = "A_ZERO") + + out <- get_labels_from_stats(.stats, .labels, levels_per_stats = lapply(x_stats, names)) + + testthat::expect_equal( + .unlist_keep_nulls(out), c( - count.a = "a", count.b = "Count of b", count.c = "Lvl c:", - count_fraction.a = "CF: A", count_fraction.b = "b", count_fraction.c = "Lvl c:" + n.n = "N=", + count_fraction.a = "AAAA", + count_fraction.b = "b", + count_fraction.c = "c", + count_fraction.d = "d", + count_fraction.e = "e", + a_zero.a_zero = "A_ZERO", + a_null.a_null = "a_null" ) ) }) @@ -169,19 +213,6 @@ testthat::test_that("get_indents_from_stats works as expected", { ), c(stats_to_do, n = 0L) ) - - # with row_nms - testthat::expect_identical( - get_indents_from_stats( - stats = c("count", "count_fraction"), - indents_in = c("c" = 3L, "count_fraction.a" = 1L, "count.b" = 2L), - row_nms = c("a", "b", "c") - ), - c( - count.a = 0L, count.b = 2L, count.c = 3L, - count_fraction.a = 1L, count_fraction.b = 0L, count_fraction.c = 3L - ) - ) }) testthat::test_that("labels_use_control works as expected", { @@ -217,3 +248,17 @@ testthat::test_that("summary_labels works as expected", { res <- testthat::expect_silent(result) testthat::expect_snapshot(res) }) + +testthat::test_that("get_stat_names works fine", { + stat_results <- list( + "n" = list("M" = c(n = 1), "F" = c(n = 2)), + "count_fraction" = list("M" = c(n = 1, p = 0.2), "F" = c(n = 2, p = 0.1)) + ) + out <- get_stat_names(.unlist_keep_nulls(stat_results)) + + testthat::expect_equal(out[1], list("n.M" = "n")) + testthat::expect_equal(out[4], list("count_fraction.F" = c("n", "p"))) + + out <- get_stat_names(stat_results, list("n" = "argh")) + testthat::expect_equal(out[1], list("n" = "argh")) +}) diff --git a/vignettes/missing_values.Rmd b/vignettes/missing_values.Rmd index 5b5c05aead..acfaec3e43 100644 --- a/vignettes/missing_values.Rmd +++ b/vignettes/missing_values.Rmd @@ -41,7 +41,7 @@ to demonstrate what happens when we try splitting the rows by this variable. To ```{r} adsl <- tern_ex_adsl -adsl$SEX <- as.character(adsl$SEX) +adsl$SEX <- as.factor(adsl$SEX) vars <- c("AGE", "SEX", "RACE", "BMRKR1") var_labels <- c( diff --git a/vignettes/tern_functions_guide.Rmd b/vignettes/tern_functions_guide.Rmd index 6dc8e2377f..cdc04ce69a 100644 --- a/vignettes/tern_functions_guide.Rmd +++ b/vignettes/tern_functions_guide.Rmd @@ -66,7 +66,6 @@ fix_layout <- basic_table() %>% split_cols_by("ARM") %>% split_rows_by("AVISIT") - # Dealing with NAs: na_rm = TRUE fix_layout %>% summarize_change("CHG", variables = list(value = "AVAL", baseline_flag = "ABLFLL")) %>% @@ -137,6 +136,8 @@ fix_layout %>% In all of these layers there are specific parameters that need to be available, and, while `rtables` has multiple way to handle formatting and `NA` values, we had to decide how to correctly handle these and additional extra arguments. We follow the following scheme: -Level 1: `summarize_change()`: all parameters without a starting dot `.*` are used or added to `extra_args`. Specifically, here we solve `NA` values by using `inclNAs` option in `rtables::analyze()`. This will add to `...` `na.rm = inclNAs`. Also `na_str` is here set. We may want to be statistic dependent in the future, but we still need to think how to accomplish that. We add the `rtables::additional_fun_params` to the analysis function so to make them available as `...` in the next level. +Level 1: `summarize_change()`: all parameters without a starting dot `.*` are used or added to `extra_args`. Specifically, here we solve `NA` values by using `inclNAs = TRUE` always in `rtables::analyze()`. This will keep `NA` values to the analysis function `a_*`. Please follow the way `na_rm` is used in `summarize_change`, and you will see how to retrieve it from `...` only when you need it. In this case, only at the `summary()` level. `na_str`, instead is set only on the top level (in the `rtables::analyze()` call). We may want to be statistic-dependent in the future, but we still need to think how to accomplish that. We add the `rtables::additional_fun_params` to the analysis function so to make them available as `...` in the next level. Note that they all can be retrieved with `list(...)[["na_rm"]]`. + +Level 2: `a_change_from_baseline()`: all parameters starting with a dot `.` are ideally used or transmitted into lower functions from here. Mainly `.stats`, `.formats`, `.labels`, and `.indent_mods` are used only at this level. We also bring forward `extra_afun_params` to the `...` list for the statistical function. Notice the handling for additional parameters in the `do.call()` function. -Level 2: `a_change_from_baseline()`: all parameters starting with a dot `.` are used. Mainly `.stats`, `.formats`, `.labels`, and `.indent_mods` are used. We also add `extra_afun_params` to the `...` list for the statistical function. Notice the handling for additional parameters in the `do.call()` function. +Level 3 and beyond: `s_*` functions. In this case `s_summary` is at the end used and the result brought into the main `a_*` function.