From 9c2909f548d16f1451b01f7f34072fbf9fc15399 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 15:20:47 +0100 Subject: [PATCH 01/11] Fix order --- R/analyze_variables.R | 13 ++++++------- R/utils_default_stats_formats_labels.R | 19 ++++++++++++++----- man/default_stats_formats_labels.Rd | 6 +++++- 3 files changed, 25 insertions(+), 13 deletions(-) diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 2c888713ea..4f77f9ad5e 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -549,7 +549,7 @@ a_summary <- function(x, # 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 + .stats <- default_and_custom_stats_list$all_stats # just the labels of stats custom_stat_functions <- default_and_custom_stats_list$custom_stats # Correction of the pval indication if it is numeric or counts @@ -588,12 +588,11 @@ a_summary <- function(x, # Fill in with stats defaults if needed met_grp <- paste0(c("analyze_vars", type), collapse = "_") - .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 + .stats <- get_stats( + met_grp, + stats_in = .stats, + custom_stats_in = names(custom_stat_functions), + add_pval = dots_extra_args$compare_with_ref_group %||% FALSE ) x_stats <- x_stats[.stats] diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 84dba5b9ac..aff7787991 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -33,7 +33,9 @@ NULL #' @param method_groups (`character`)\cr indicates the statistical method group (`tern` analyze function) #' to retrieve default statistics for. A character vector can be used to specify more than one statistical #' method group. -#' @param stats_in (`character`)\cr statistics to retrieve for the selected method group. +#' @param stats_in (`character`)\cr statistics to retrieve for the selected method group. If custom statistical +#' functions are used, `stats_in` needs to have them in too. +#' @param custom_stats_in (`character`)\cr custom statistics to add to the default statistics. #' @param add_pval (`flag`)\cr should `"pval"` (or `"pval_counts"` if `method_groups` contains #' `"analyze_vars_counts"`) be added to the statistical methods? #' @@ -57,9 +59,11 @@ NULL #' get_stats(c("count_occurrences", "analyze_vars_counts")) #' #' @export -get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, add_pval = FALSE) { +get_stats <- function(method_groups = "analyze_vars_numeric", + stats_in = NULL, custom_stats_in = NULL, add_pval = FALSE) { checkmate::assert_character(method_groups) checkmate::assert_character(stats_in, null.ok = TRUE) + checkmate::assert_character(custom_stats_in, null.ok = TRUE) checkmate::assert_flag(add_pval) # Default is still numeric @@ -82,6 +86,9 @@ get_stats <- function(method_groups = "analyze_vars_numeric", stats_in = NULL, a out <- unique(c(out, out_tmp)) } + # Add custom stats + out <- c(out, custom_stats_in) + # If you added pval to the stats_in you certainly want it if (!is.null(stats_in) && any(grepl("^pval", stats_in))) { stats_in_pval_value <- stats_in[grepl("^pval", stats_in)] @@ -172,16 +179,18 @@ get_stat_names <- function(stat_results, stat_names_in = NULL) { # 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) + out <- list(default_stats = NULL, custom_stats = NULL, all_stats = NULL) if (is.list(stats_in)) { is_custom_fnc <- sapply(stats_in, is.function) checkmate::assert_list(stats_in[is_custom_fnc], types = "function", names = "named") out[["custom_stats"]] <- stats_in[is_custom_fnc] out[["default_stats"]] <- unlist(stats_in[!is_custom_fnc]) + all_stats <- names(stats_in) # to keep the order + all_stats[!is_custom_fnc] <- out[["default_stats"]] + out[["all_stats"]] <- all_stats } else { - out[["default_stats"]] <- stats_in + out[["default_stats"]] <- out[["all_stats"]] <- stats_in } - out } diff --git a/man/default_stats_formats_labels.Rd b/man/default_stats_formats_labels.Rd index dc31e3d1b3..ff8194a312 100644 --- a/man/default_stats_formats_labels.Rd +++ b/man/default_stats_formats_labels.Rd @@ -34,6 +34,7 @@ named for their corresponding statistic. get_stats( method_groups = "analyze_vars_numeric", stats_in = NULL, + custom_stats_in = NULL, add_pval = FALSE ) @@ -76,7 +77,10 @@ summary_labels(type = "numeric", include_pval = FALSE) to retrieve default statistics for. A character vector can be used to specify more than one statistical method group.} -\item{stats_in}{(\code{character})\cr statistics to retrieve for the selected method group.} +\item{stats_in}{(\code{character})\cr statistics to retrieve for the selected method group. If custom statistical +functions are used, \code{stats_in} needs to have them in too.} + +\item{custom_stats_in}{(\code{character})\cr custom statistics to add to the default statistics.} \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?} From a6d9a559d1288afbc7eec824dae7f9c6513d7d40 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 15:22:58 +0100 Subject: [PATCH 02/11] fix all other cases --- R/count_values.R | 9 +++++---- R/summarize_change.R | 9 +++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/count_values.R b/R/count_values.R index 0a74b60b7a..1532ce8979 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -118,7 +118,7 @@ a_count_values <- function(x, # Check for user-defined functions default_and_custom_stats_list <- .split_std_from_custom_stats(.stats) - .stats <- default_and_custom_stats_list$default_stats + .stats <- default_and_custom_stats_list$all_stats # just the labels of stats custom_stat_functions <- default_and_custom_stats_list$custom_stats # Add extra parameters to the s_* function @@ -139,9 +139,10 @@ a_count_values <- function(x, ) # Fill in formatting defaults - .stats <- c( - get_stats("analyze_vars_counts", stats_in = .stats), - names(custom_stat_functions) # Additional stats from custom functions + .stats <- get_stats( + "analyze_vars_counts", + stats_in = .stats, + custom_stats_in = names(custom_stat_functions), ) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) diff --git a/R/summarize_change.R b/R/summarize_change.R index 83c6025284..fc86806952 100644 --- a/R/summarize_change.R +++ b/R/summarize_change.R @@ -67,7 +67,7 @@ a_change_from_baseline <- function(df, # 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 + .stats <- default_and_custom_stats_list$all_stats # just the labels of stats custom_stat_functions <- default_and_custom_stats_list$custom_stats # Adding automatically extra parameters to the statistic function (see ?rtables::additional_fun_params) @@ -88,9 +88,10 @@ a_change_from_baseline <- function(df, ) # Fill in with formatting defaults if needed - .stats <- c( - get_stats("analyze_vars_numeric", stats_in = .stats), - names(custom_stat_functions) # Additional stats from custom functions + .stats <- get_stats( + "analyze_vars_numeric", + stats_in = .stats, + custom_stats_in = names(custom_stat_functions), ) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) From 36ede33f118f5a1285d99e1a95c085902a4afd46 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 15:51:50 +0100 Subject: [PATCH 03/11] add tests --- R/analyze_variables.R | 14 +++++- R/utils_default_stats_formats_labels.R | 6 ++- man/analyze_variables.Rd | 2 +- man/compare_variables.Rd | 2 +- man/summarize_change.Rd | 2 +- tests/testthat/test-analyze_variables.R | 66 +++++++++++++++++++++++++ 6 files changed, 87 insertions(+), 5 deletions(-) diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 4f77f9ad5e..9b5b27a485 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -234,10 +234,22 @@ s_summary.numeric <- function(x, control = control_analyze_vars(), ...) { y$cv <- c("cv" = unname(y$sd) / unname(y$mean) * 100) - # Convert negative values to NA for log calculation. + # Geometric Mean - Convert negative values to NA for log calculation. + geom_verbose <- args_list[["geom_verbose"]] %||% FALSE # Additional info if requested + checkmate::assert_flag(geom_verbose) x_no_negative_vals <- x x_no_negative_vals[x_no_negative_vals <= 0] <- NA + if (geom_verbose) { + if (any(x <= 0)) { + warning("Negative values were converted to NA for calculation of the geometric mean.") + } + if (all(is.na(x_no_negative_vals))) { + warning("All values are negative or NA. The geometric mean is NA.") + } + } y$geom_mean <- c("geom_mean" = exp(mean(log(x_no_negative_vals), na.rm = FALSE))) + y$geom_sd <- c("geom_sd" = geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE))) + y$geom_mean_sd <- c("geom_mean" = y$geom_mean, "geom_sd" = y$geom_sd) geom_mean_ci <- stat_mean_ci(x, conf_level = control$conf_level, na.rm = FALSE, gg_helper = FALSE, geom_mean = TRUE) y$geom_mean_ci <- formatters::with_label(geom_mean_ci, paste("Geometric Mean", f_conf_level(control$conf_level))) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index aff7787991..cb6d824d43 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -509,7 +509,7 @@ tern_default_stats <- list( analyze_vars_numeric = c( "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", + "geom_mean", "geom_sd", "geom_mean_sd", "geom_mean_ci", "geom_cv", "median_ci_3d", "mean_ci_3d", "geom_mean_ci_3d" ), @@ -589,6 +589,8 @@ tern_default_formats <- c( median_range = "xx.x (xx.x - xx.x)", cv = "xx.x", geom_mean = "xx.x", + geom_sd = "xx.x", + geom_mean_sd = "xx.x (xx.x)", geom_mean_ci = "(xx.xx, xx.xx)", geom_mean_ci_3d = "xx.xx (xx.xx - xx.xx)", geom_cv = "xx.x", @@ -640,6 +642,8 @@ tern_default_labels <- c( median_range = "Median (Min - Max)", cv = "CV (%)", geom_mean = "Geometric Mean", + geom_sd = "Geometric SD", + geom_mean_sd = "Geometric Mean (SD)", geom_mean_ci = "Geometric Mean 95% CI", geom_mean_ci_3d = "Geometric Mean (95% CI)", geom_cv = "CV % Geometric Mean", diff --git a/man/analyze_variables.Rd b/man/analyze_variables.Rd index 4f2dc341c6..79a58cb423 100644 --- a/man/analyze_variables.Rd +++ b/man/analyze_variables.Rd @@ -89,7 +89,7 @@ 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 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_sd', 'geom_mean_sd', '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'}} diff --git a/man/compare_variables.Rd b/man/compare_variables.Rd index 29486bd437..e18513e461 100644 --- a/man/compare_variables.Rd +++ b/man/compare_variables.Rd @@ -74,7 +74,7 @@ defined by this split instruction, or \code{NA_character_} (the default) for no \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', 'pval'} +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_sd', 'geom_mean_sd', 'geom_mean_ci', 'geom_cv', 'median_ci_3d', 'mean_ci_3d', 'geom_mean_ci_3d', 'pval'} Options for non-numeric variables are: \verb{'n', 'count', 'count_fraction', 'count_fraction_fixed_dp', 'fraction', 'n_blq', 'pval_counts'}} diff --git a/man/summarize_change.Rd b/man/summarize_change.Rd index c99ec2b13f..96410a730c 100644 --- a/man/summarize_change.Rd +++ b/man/summarize_change.Rd @@ -67,7 +67,7 @@ defined by this split instruction, or \code{NA_character_} (the default) for no \item{.stats}{(\code{character})\cr statistics to select for the table. -Options 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 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_sd', 'geom_mean_sd', 'geom_mean_ci', 'geom_cv', 'median_ci_3d', 'mean_ci_3d', 'geom_mean_ci_3d'}} \item{.formats}{(named \code{character} or \code{list})\cr formats for the statistics. See Details in \code{analyze_vars} for more information on the \code{"auto"} setting.} diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 6fcb0fe4f2..50779f2538 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -618,3 +618,69 @@ testthat::test_that("analyze_vars works well with additional stat names (.stat_n c("VAR2", "a_zero", "A_ZERO", NA, 0) ) }) + +testthat::test_that("analyze_vars keeps the order of mixed custom fnc and defaults", { + # Regression test for custom function ordering + result <- basic_table() %>% + analyze_vars( + .stats = list("n", + "another function" = function(x, ...) { + return(0) + }, + "geom_sd_custom" = function(x, ...) { + x_no_negative_vals <- x + x_no_negative_vals[x_no_negative_vals <= 0] <- NA + + # exp(sd(log(x_no_negative_vals), na.rm = FALSE)) + geom_mean <- exp(mean(log(x_no_negative_vals), na.rm = FALSE)) + geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE)) + + rcell(c(geom_mean, geom_sd)) + }, + "geom_mean_sd" + ), + vars = "AGE", + var_labels = "Age (yr)", + .formats = c("another function" = "xx.xxx", geom_sd_custom = "xx.xx (xx.xx)") + ) %>% + build_table(tern_ex_adsl) + + expect_identical( + strsplit(toString(matrix_form(result), hsep = "-"), "\n")[[1]], + c( + " all obs ", + "----------------------------------", + "n 200 ", + "another function 0.000 ", + "geom_sd_custom 34.65 (1.22)", + "Geometric Mean (SD) 34.7 (1.2) " + ) + ) +}) + +testthat::test_that("analyze_vars warnings for geom_verbose work", { + tmp_df <- data.frame("VAR1" = c(1, 2, 3, 0, -1, -2), "VAR2" = 0) + expect_warning( + result <- basic_table() %>% + analyze_vars("VAR1", .stats = "geom_mean_sd", geom_verbose = TRUE) %>% + build_table(tmp_df), + "Negative values were converted to NA" + ) + + # Do we expect output to be NA? + expect_true(all(is.na(cell_values(result)[[1]]))) + + # All NAs + expect_warning( + expect_warning( + result2 <- basic_table() %>% + analyze_vars("VAR2", .stats = "geom_mean_sd", geom_verbose = TRUE) %>% + build_table(tmp_df), + "All values are negative or NA" + ), + "Negative values were converted to NA" + ) + + # Do we expect output to be NA? + expect_true(all(is.na(cell_values(result2)[[1]]))) +}) From ee617bb4e43c99fd11ff3f90f53ed96feb222e44 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 15:52:09 +0100 Subject: [PATCH 04/11] styler --- tests/testthat/test-analyze_variables.R | 28 ++++++++++++------------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 50779f2538..597be7dff8 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -624,20 +624,20 @@ testthat::test_that("analyze_vars keeps the order of mixed custom fnc and defaul result <- basic_table() %>% analyze_vars( .stats = list("n", - "another function" = function(x, ...) { - return(0) - }, - "geom_sd_custom" = function(x, ...) { - x_no_negative_vals <- x - x_no_negative_vals[x_no_negative_vals <= 0] <- NA - - # exp(sd(log(x_no_negative_vals), na.rm = FALSE)) - geom_mean <- exp(mean(log(x_no_negative_vals), na.rm = FALSE)) - geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE)) - - rcell(c(geom_mean, geom_sd)) - }, - "geom_mean_sd" + "another function" = function(x, ...) { + return(0) + }, + "geom_sd_custom" = function(x, ...) { + x_no_negative_vals <- x + x_no_negative_vals[x_no_negative_vals <= 0] <- NA + + # exp(sd(log(x_no_negative_vals), na.rm = FALSE)) + geom_mean <- exp(mean(log(x_no_negative_vals), na.rm = FALSE)) + geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE)) + + rcell(c(geom_mean, geom_sd)) + }, + "geom_mean_sd" ), vars = "AGE", var_labels = "Age (yr)", From e7b2802516364bd0e36c2c3a446a9547bc7f983f Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Thu, 20 Feb 2025 14:56:51 +0000 Subject: [PATCH 05/11] [skip style] [skip vbump] Restyle files --- R/count_values.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/count_values.R b/R/count_values.R index 1532ce8979..c5fc88ba69 100644 --- a/R/count_values.R +++ b/R/count_values.R @@ -140,9 +140,9 @@ a_count_values <- function(x, # Fill in formatting defaults .stats <- get_stats( - "analyze_vars_counts", - stats_in = .stats, - custom_stats_in = names(custom_stat_functions), + "analyze_vars_counts", + stats_in = .stats, + custom_stats_in = names(custom_stat_functions), ) .formats <- get_formats_from_stats(.stats, .formats) .labels <- get_labels_from_stats(.stats, .labels) From d7a5c01688e30a2ea54e505871496efaa86a2782 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 16:06:20 +0100 Subject: [PATCH 06/11] news --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 7a40545c5b..17e1cc8853 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,14 +2,17 @@ ### Enhancements * Refactored `count_abnormal()`, `count_abnormal_by_baseline()`, `count_abnormal_by_marked()`, `count_abnormal_by_worst_grade()`, and `count_abnormal_lab_worsen_by_baseline()` to work without `make_afun()`. +* Added `geom_sd` and `geom_mean_sd` to `s_summary()` default available statistics. ### Bug Fixes * Fixed bug in `a_count_patients_with_flags()` preventing select custom label and indentation specification formats from being applied. * Fixed bug in `tabulate_rsp_subgroups` and `tabulate_survival_subgroups` preventing the `pct` option from having an effect when adding a risk difference column. +* Fixed bug with the order of `.stats` when adding custom statistical functions. ### Miscellaneous * Removed internal function `ungroup_stats()` and replaced its usage with the `get_*_from_stats()` functions. * Began deprecation of the unused `table_names` argument to `count_abnormal_lab_worsen_by_baseline()`. +* Added warnings for `geom_mean` statistical output. # tern 0.9.7 From 53bf03d1667da46ac8c25e1114c7bc65aabce406 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Thu, 20 Feb 2025 17:16:14 +0100 Subject: [PATCH 07/11] fix --- R/analyze_variables.R | 5 +- tests/testthat/_snaps/analyze_variables.md | 70 ++++++++++++++++++---- tests/testthat/_snaps/summarize_change.md | 32 ++++++++++ tests/testthat/test-analyze_variables.R | 1 - 4 files changed, 93 insertions(+), 15 deletions(-) diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 9b5b27a485..763e256602 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -238,6 +238,9 @@ s_summary.numeric <- function(x, control = control_analyze_vars(), ...) { geom_verbose <- args_list[["geom_verbose"]] %||% FALSE # Additional info if requested checkmate::assert_flag(geom_verbose) x_no_negative_vals <- x + if (identical(x_no_negative_vals, numeric())) { + x_no_negative_vals <- NA + } x_no_negative_vals[x_no_negative_vals <= 0] <- NA if (geom_verbose) { if (any(x <= 0)) { @@ -249,7 +252,7 @@ s_summary.numeric <- function(x, control = control_analyze_vars(), ...) { } y$geom_mean <- c("geom_mean" = exp(mean(log(x_no_negative_vals), na.rm = FALSE))) y$geom_sd <- c("geom_sd" = geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE))) - y$geom_mean_sd <- c("geom_mean" = y$geom_mean, "geom_sd" = y$geom_sd) + y$geom_mean_sd <- c(y$geom_mean, y$geom_sd) geom_mean_ci <- stat_mean_ci(x, conf_level = control$conf_level, na.rm = FALSE, gg_helper = FALSE, geom_mean = TRUE) y$geom_mean_ci <- formatters::with_label(geom_mean_ci, paste("Geometric Mean", f_conf_level(control$conf_level))) diff --git a/tests/testthat/_snaps/analyze_variables.md b/tests/testthat/_snaps/analyze_variables.md index 8837a305f4..0952192877 100644 --- a/tests/testthat/_snaps/analyze_variables.md +++ b/tests/testthat/_snaps/analyze_variables.md @@ -117,7 +117,15 @@ $geom_mean geom_mean - NaN + NA + + $geom_sd + geom_sd + NA + + $geom_mean_sd + geom_mean geom_sd + NA NA $geom_mean_ci mean_ci_lwr mean_ci_upr @@ -131,7 +139,7 @@ $geom_mean_ci_3d geom_mean mean_ci_lwr mean_ci_upr - NaN NA NA + NA NA NA attr(,"label") [1] "Geometric Mean (95% CI)" @@ -257,6 +265,14 @@ geom_mean 1 + $geom_sd + geom_sd + NA + + $geom_mean_sd + geom_mean geom_sd + 1 NA + $geom_mean_ci mean_ci_lwr mean_ci_upr NA NA @@ -395,6 +411,14 @@ geom_mean NA + $geom_sd + geom_sd + NA + + $geom_mean_sd + geom_mean geom_sd + NA NA + $geom_mean_ci mean_ci_lwr mean_ci_upr NA NA @@ -533,6 +557,14 @@ geom_mean 1.414214 + $geom_sd + geom_sd + 1.632527 + + $geom_mean_sd + geom_mean geom_sd + 1.414214 1.632527 + $geom_mean_ci mean_ci_lwr mean_ci_upr 0.01729978 115.60839614 @@ -671,6 +703,14 @@ geom_mean 4.842534 + $geom_sd + geom_sd + 2.252326 + + $geom_mean_sd + geom_mean geom_sd + 4.842534 2.252326 + $geom_mean_ci mean_ci_lwr mean_ci_upr 2.456211 9.547283 @@ -1388,11 +1428,13 @@ 20 median_range 0.3 (-0.8 - 1.6) 0 Median (Min - Max) 21 cv 590.4 0 CV (%) 22 geom_mean NA 0 Geometric Mean - 23 geom_mean_ci NA 0 Geometric Mean 95% CI - 24 geom_cv NA 0 CV % Geometric Mean - 25 median_ci_3d 0.26 (-0.82 - 0.74) 0 Median (95% CI) - 26 mean_ci_3d 0.13 (-0.43 - 0.69) 0 Mean (95% CI) - 27 geom_mean_ci_3d NA 0 Geometric Mean (95% CI) + 23 geom_sd NA 0 Geometric SD + 24 geom_mean_sd NA 0 Geometric Mean (SD) + 25 geom_mean_ci NA 0 Geometric Mean 95% CI + 26 geom_cv NA 0 CV % Geometric Mean + 27 median_ci_3d 0.26 (-0.82 - 0.74) 0 Median (95% CI) + 28 mean_ci_3d 0.13 (-0.43 - 0.69) 0 Mean (95% CI) + 29 geom_mean_ci_3d NA 0 Geometric Mean (95% CI) --- @@ -1523,12 +1565,14 @@ 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) + 23 geom_sd 1.2 0 Geometric SD + 24 geom_mean_sd 4.8 (1.2) 0 Geometric Mean (SD) + 25 geom_mean_ci (4.07, 5.58) 0 Geometric Mean 95% CI + 26 geom_cv 22.3 0 CV % Geometric Mean + 27 median_ci_3d 5.01 (3.53 - 5.78) 0 Median (95% CI) + 28 mean_ci_3d 4.87 (4.18 - 5.55) 0 Mean (95% CI) + 29 geom_mean_ci_3d 4.77 (4.07 - 5.58) 0 Geometric Mean (95% CI) + 30 pval <0.0001 0 p-value (t-test) --- diff --git a/tests/testthat/_snaps/summarize_change.md b/tests/testthat/_snaps/summarize_change.md index 520ff1d99d..accb692a59 100644 --- a/tests/testthat/_snaps/summarize_change.md +++ b/tests/testthat/_snaps/summarize_change.md @@ -119,6 +119,14 @@ geom_mean NaN + $geom_sd + geom_sd + NA + + $geom_mean_sd + geom_mean.geom_mean geom_sd.geom_sd + NaN NA + $geom_mean_ci mean_ci_lwr mean_ci_upr NA NA @@ -257,6 +265,14 @@ geom_mean NA + $geom_sd + geom_sd + NA + + $geom_mean_sd + geom_mean.geom_mean geom_sd.geom_sd + NA NA + $geom_mean_ci mean_ci_lwr mean_ci_upr NA NA @@ -396,6 +412,14 @@ geom_mean 1.414214 + $`FALSE`$geom_sd + geom_sd + 1.632527 + + $`FALSE`$geom_mean_sd + geom_mean.geom_mean geom_sd.geom_sd + 1.414214 1.632527 + $`FALSE`$geom_mean_ci mean_ci_lwr mean_ci_upr 0.01729978 115.60839614 @@ -530,6 +554,14 @@ geom_mean 2 + $`TRUE`$geom_sd + geom_sd + 2.665144 + + $`TRUE`$geom_mean_sd + geom_mean.geom_mean geom_sd.geom_sd + 2.000000 2.665144 + $`TRUE`$geom_mean_ci mean_ci_lwr mean_ci_upr 2.992824e-04 1.336530e+04 diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 597be7dff8..6972d04490 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -631,7 +631,6 @@ testthat::test_that("analyze_vars keeps the order of mixed custom fnc and defaul x_no_negative_vals <- x x_no_negative_vals[x_no_negative_vals <= 0] <- NA - # exp(sd(log(x_no_negative_vals), na.rm = FALSE)) geom_mean <- exp(mean(log(x_no_negative_vals), na.rm = FALSE)) geom_sd <- exp(sd(log(x_no_negative_vals), na.rm = FALSE)) From 7f536d31c952ba226288e7658921144189c89132 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Fri, 21 Feb 2025 10:21:00 +0100 Subject: [PATCH 08/11] change snaps --- tests/testthat/_snaps/compare_variables.md | 3 ++- tests/testthat/_snaps/summarize_change.md | 20 +++++++++--------- .../utils_default_stats_formats_labels.md | 21 +++++++++++++------ 3 files changed, 27 insertions(+), 17 deletions(-) diff --git a/tests/testthat/_snaps/compare_variables.md b/tests/testthat/_snaps/compare_variables.md index 8082454779..94d0b967f3 100644 --- a/tests/testthat/_snaps/compare_variables.md +++ b/tests/testthat/_snaps/compare_variables.md @@ -9,7 +9,8 @@ [13] "median" "mad" "median_ci" "median_ci_3d" [17] "quantiles" "iqr" "range" "min" [21] "max" "median_range" "cv" "geom_mean" - [25] "geom_mean_ci" "geom_cv" "geom_mean_ci_3d" "pval" + [25] "geom_sd" "geom_mean_sd" "geom_mean_ci" "geom_cv" + [29] "geom_mean_ci_3d" "pval" # s_compare for numeric does not give p-value when not at least 2 values in each group diff --git a/tests/testthat/_snaps/summarize_change.md b/tests/testthat/_snaps/summarize_change.md index accb692a59..18ce511b25 100644 --- a/tests/testthat/_snaps/summarize_change.md +++ b/tests/testthat/_snaps/summarize_change.md @@ -117,15 +117,15 @@ $geom_mean geom_mean - NaN + NA $geom_sd geom_sd NA $geom_mean_sd - geom_mean.geom_mean geom_sd.geom_sd - NaN NA + geom_mean geom_sd + NA NA $geom_mean_ci mean_ci_lwr mean_ci_upr @@ -139,7 +139,7 @@ $geom_mean_ci_3d geom_mean mean_ci_lwr mean_ci_upr - NaN NA NA + NA NA NA attr(,"label") [1] "Geometric Mean (95% CI)" @@ -270,8 +270,8 @@ NA $geom_mean_sd - geom_mean.geom_mean geom_sd.geom_sd - NA NA + geom_mean geom_sd + NA NA $geom_mean_ci mean_ci_lwr mean_ci_upr @@ -417,8 +417,8 @@ 1.632527 $`FALSE`$geom_mean_sd - geom_mean.geom_mean geom_sd.geom_sd - 1.414214 1.632527 + geom_mean geom_sd + 1.414214 1.632527 $`FALSE`$geom_mean_ci mean_ci_lwr mean_ci_upr @@ -559,8 +559,8 @@ 2.665144 $`TRUE`$geom_mean_sd - geom_mean.geom_mean geom_sd.geom_sd - 2.000000 2.665144 + geom_mean geom_sd + 2.000000 2.665144 $`TRUE`$geom_mean_ci mean_ci_lwr mean_ci_upr diff --git a/tests/testthat/_snaps/utils_default_stats_formats_labels.md b/tests/testthat/_snaps/utils_default_stats_formats_labels.md index bce322823d..d3dabb8ef8 100644 --- a/tests/testthat/_snaps/utils_default_stats_formats_labels.md +++ b/tests/testthat/_snaps/utils_default_stats_formats_labels.md @@ -32,8 +32,9 @@ [9] "mean_sei" "mean_sdi" "mean_pval" "median" [13] "mad" "median_ci" "quantiles" "iqr" [17] "range" "min" "max" "median_range" - [21] "cv" "geom_mean" "geom_mean_ci" "geom_cv" - [25] "median_ci_3d" "mean_ci_3d" "geom_mean_ci_3d" + [21] "cv" "geom_mean" "geom_sd" "geom_mean_sd" + [25] "geom_mean_ci" "geom_cv" "median_ci_3d" "mean_ci_3d" + [29] "geom_mean_ci_3d" # get_labels_from_stats works as expected @@ -114,10 +115,12 @@ "xx.x" "xx.x - xx.x" "xx.x" max median_range cv "xx.x" "xx.x (xx.x - xx.x)" "xx.x" - geom_mean geom_mean_ci geom_cv - "xx.x" "(xx.xx, xx.xx)" "xx.x" - median_ci_3d mean_ci_3d geom_mean_ci_3d - "xx.xx (xx.xx - xx.xx)" "xx.xx (xx.xx - xx.xx)" "xx.xx (xx.xx - xx.xx)" + geom_mean geom_sd geom_mean_sd + "xx.x" "xx.x" "xx.x (xx.x)" + geom_mean_ci geom_cv median_ci_3d + "(xx.xx, xx.xx)" "xx.x" "xx.xx (xx.xx - xx.xx)" + mean_ci_3d geom_mean_ci_3d + "xx.xx (xx.xx - xx.xx)" "xx.xx (xx.xx - xx.xx)" # summary_labels works as expected @@ -190,6 +193,12 @@ $geom_mean [1] "Geometric Mean" + $geom_sd + [1] "Geometric SD" + + $geom_mean_sd + [1] "Geometric Mean (SD)" + $geom_mean_ci [1] "Geometric Mean 95% CI" From b48d6f8d2e824258a688220f8fe93453ee763a4b Mon Sep 17 00:00:00 2001 From: Davide Garolini Date: Mon, 24 Feb 2025 16:31:43 +0100 Subject: [PATCH 09/11] Update R/analyze_variables.R Co-authored-by: Emily de la Rua Signed-off-by: Davide Garolini --- R/analyze_variables.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/analyze_variables.R b/R/analyze_variables.R index 763e256602..ca12d9fbbb 100644 --- a/R/analyze_variables.R +++ b/R/analyze_variables.R @@ -247,7 +247,7 @@ s_summary.numeric <- function(x, control = control_analyze_vars(), ...) { warning("Negative values were converted to NA for calculation of the geometric mean.") } if (all(is.na(x_no_negative_vals))) { - warning("All values are negative or NA. The geometric mean is NA.") + warning("Since all values are negative or NA, the geometric mean is NA.") } } y$geom_mean <- c("geom_mean" = exp(mean(log(x_no_negative_vals), na.rm = FALSE))) From 9277a773fe403c3b50c514ffb68b0e16e462522f Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 24 Feb 2025 17:29:57 +0100 Subject: [PATCH 10/11] fix lintr --- R/utils_default_stats_formats_labels.R | 2 +- tests/testthat/test-analyze_variables.R | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index cb6d824d43..28bfc80954 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -164,7 +164,7 @@ get_stat_names <- function(stat_results, stat_names_in = NULL) { if (is.null(nm)) { nm <- rep(NA_character_, length(si)) # no statistical names } - return(nm) + nm }) # Modify some with custom stat names diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 6972d04490..1a9486fed0 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -561,10 +561,10 @@ testthat::test_that("analyze_vars works well with additional stat names (.stat_n vars = c("VAR", "VAR2"), .stats = c("n", "mean", "a" = function(x, ...) { - return(0) + 0 }, "v" = function(x, ...) { - return(0) + 0 } ), .stat_names = list("n" = "CoUnT", "v" = "something"), @@ -593,7 +593,7 @@ testthat::test_that("analyze_vars works well with additional stat names (.stat_n vars = c("VAR", "VAR2"), .stats = c("n", "mean", "count_fraction", "a_zero" = function(x, ...) { - return(0) + 0 } ), .stat_names = list("n" = "CoUnT", "v" = "something"), @@ -625,7 +625,7 @@ testthat::test_that("analyze_vars keeps the order of mixed custom fnc and defaul analyze_vars( .stats = list("n", "another function" = function(x, ...) { - return(0) + 0 }, "geom_sd_custom" = function(x, ...) { x_no_negative_vals <- x From 396888af1545eee424dd34526c42ba8495722229 Mon Sep 17 00:00:00 2001 From: Melkiades Date: Mon, 24 Feb 2025 17:33:24 +0100 Subject: [PATCH 11/11] fix warning --- tests/testthat/test-analyze_variables.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-analyze_variables.R b/tests/testthat/test-analyze_variables.R index 1a9486fed0..7043f1ef10 100644 --- a/tests/testthat/test-analyze_variables.R +++ b/tests/testthat/test-analyze_variables.R @@ -675,7 +675,7 @@ testthat::test_that("analyze_vars warnings for geom_verbose work", { result2 <- basic_table() %>% analyze_vars("VAR2", .stats = "geom_mean_sd", geom_verbose = TRUE) %>% build_table(tmp_df), - "All values are negative or NA" + "Since all values are negative or NA" ), "Negative values were converted to NA" )