From a4ccbe764bf7648fbaf420f10c067dee8f3df13d Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 6 May 2026 16:34:07 +0200 Subject: [PATCH 01/33] update: add additional `lr_stat_df` statistic. --- R/survival_coxph_pairwise.R | 39 ++++++++++++++++--- man/survival_coxph_pairwise.Rd | 4 ++ .../_snaps/survival_coxph_pairwise.md | 32 ++++++++++++--- tests/testthat/test-survival_coxph_pairwise.R | 28 ++++++++++++- 4 files changed, 90 insertions(+), 13 deletions(-) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index 742700ec9b..512b2cea54 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -47,6 +47,7 @@ s_coxph_pairwise <- function(df, strata = NULL, strat = lifecycle::deprecated(), control = control_coxph(), + alternative = c("two.sided", "less", "greater"), ...) { if (lifecycle::is_present(strat)) { lifecycle::deprecate_warn("0.9.4", "s_coxph_pairwise(strat)", "s_coxph_pairwise(strata)") @@ -57,6 +58,8 @@ s_coxph_pairwise <- function(df, checkmate::assert_numeric(df[[.var]]) checkmate::assert_logical(df[[is_event]]) assert_df_with_variables(df, list(tte = .var, is_event = is_event)) + alternative <- match.arg(alternative) + pval_method <- control$pval_method ties <- control$ties conf_level <- control$conf_level @@ -65,6 +68,7 @@ s_coxph_pairwise <- function(df, return( list( pvalue = formatters::with_label(numeric(), paste0("p-value (", pval_method, ")")), + lr_stat_df = formatters::with_label(numeric(), "Log-rank Degrees of freedom"), hr = formatters::with_label(numeric(), "Hazard Ratio"), hr_ci = formatters::with_label(numeric(), f_conf_level(conf_level)), hr_ci_3d = formatters::with_label(numeric(), paste0("Hazard Ratio (", f_conf_level(conf_level), ")")), @@ -99,19 +103,44 @@ s_coxph_pairwise <- function(df, ties = ties ) sum_cox <- summary(cox_fit, conf.int = conf_level, extend = TRUE) - orginal_survdiff <- survival::survdiff( - formula_cox, - data = df_cox - ) - log_rank_pvalue <- 1 - pchisq(orginal_survdiff$chisq, length(orginal_survdiff$n) - 1) + original_survdiff <- survival::survdiff(formula_cox, data = df_cox) + log_rank_stat <- original_survdiff$chisq + + # See survival::survdiff for the d.f. calculation. + etmp <- if (is.matrix(original_survdiff$exp)) { + apply(original_survdiff$exp, 1, sum) + } else { + original_survdiff$exp + } + log_rank_df <- (sum(1 * (etmp > 0))) - 1 + # Check the consistency of the d.f. with the p-value returned by survival::survdiff. + log_rank_pvalue <- stats::pchisq(log_rank_stat, log_rank_df, lower.tail = FALSE) + checkmate::assert_true(all.equal(log_rank_pvalue, original_survdiff$pvalue)) pval <- switch(pval_method, "wald" = sum_cox$waldtest["pvalue"], "log-rank" = log_rank_pvalue, # pvalue from original log-rank test survival::survdiff() "likelihood" = sum_cox$logtest["pvalue"] ) + + # Handle one-sided alternatives. + if (alternative != "two.sided") { + right_direction <- if (alternative == "less") { + sum_cox$conf.int[1, 1] < 1 + } else { + sum_cox$conf.int[1, 1] >= 1 + } + pval <- if (right_direction) { + pval / 2 + } else { + 1 - pval / 2 + } + } + + list( pvalue = formatters::with_label(unname(pval), paste0("p-value (", pval_method, ")")), + lr_stat_df = formatters::with_label(unname(c(log_rank_stat, log_rank_df)), "Log-rank Degrees of freedom"), hr = formatters::with_label(sum_cox$conf.int[1, 1], "Hazard Ratio"), hr_ci = formatters::with_label(unname(sum_cox$conf.int[1, 3:4]), f_conf_level(conf_level)), hr_ci_3d = formatters::with_label( diff --git a/man/survival_coxph_pairwise.Rd b/man/survival_coxph_pairwise.Rd index e03fc6c7b5..02555aeb32 100644 --- a/man/survival_coxph_pairwise.Rd +++ b/man/survival_coxph_pairwise.Rd @@ -34,6 +34,7 @@ s_coxph_pairwise( strata = NULL, strat = lifecycle::deprecated(), control = control_coxph(), + alternative = c("two.sided", "less", "greater"), ... ) @@ -107,6 +108,9 @@ by a statistics function.} \item{is_event}{(\code{flag})\cr \code{TRUE} if event, \code{FALSE} if time to event is censored.} \item{strat}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{strata} argument instead.} + +\item{alternative}{(\code{string})\cr whether \code{two.sided}, or one-sided \code{less} or \code{greater} p-value +should be displayed.} } \value{ \itemize{ diff --git a/tests/testthat/_snaps/survival_coxph_pairwise.md b/tests/testthat/_snaps/survival_coxph_pairwise.md index fc27a5f849..2854fe820b 100644 --- a/tests/testthat/_snaps/survival_coxph_pairwise.md +++ b/tests/testthat/_snaps/survival_coxph_pairwise.md @@ -8,6 +8,11 @@ attr(,"label") [1] "p-value (log-rank)" + $lr_stat_df + [1] 2.865544 1.000000 + attr(,"label") + [1] "Log-rank Degrees of freedom" + $hr [1] 0.7108557 attr(,"label") @@ -44,6 +49,11 @@ attr(,"label") [1] "p-value (wald)" + $lr_stat_df + [1] 2.865544 1.000000 + attr(,"label") + [1] "Log-rank Degrees of freedom" + $hr [1] 0.7108557 attr(,"label") @@ -80,6 +90,11 @@ attr(,"label") [1] "p-value (log-rank)" + $lr_stat_df + [1] 4.390702 1.000000 + attr(,"label") + [1] "Log-rank Degrees of freedom" + $hr [1] 0.6251817 attr(,"label") @@ -116,6 +131,11 @@ attr(,"label") [1] "p-value (wald)" + $lr_stat_df + [1] 4.390702 1.000000 + attr(,"label") + [1] "Log-rank Degrees of freedom" + $hr [1] 0.6251817 attr(,"label") @@ -194,10 +214,10 @@ Code result Output - ARM A ARM B ARM C - ——————————————————————————————————————————————— - Unstratified Analysis - p-value (log-rank) 1.0000 1.0000 - Hazard Ratio empty empty - 95% CI empty empty + ARM A ARM B ARM C + ————————————————————————————————————————————— + Unstratified Analysis + p-value (log-rank) empty empty + Hazard Ratio empty empty + 95% CI empty empty diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index 087c0eb64d..8189886670 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -80,6 +80,30 @@ testthat::test_that("s_coxph_pairwise works with customized arguments and strati testthat::expect_snapshot(res) }) +testthat::test_that("s_coxph_pairwise works with stratification factors for Log-Rank test", { + adtte_f <- tern_ex_adtte %>% + dplyr::filter(PARAMCD == "OS") %>% + dplyr::mutate(is_event = CNSR == 0) + df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") + df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") + + # default control uses pval_method = "log-rank" + result <- s_coxph_pairwise( + df = df, + .ref_group = df_ref, + .in_ref_col = FALSE, + .var = "AVAL", + is_event = "is_event", + strata = c("SEX", "RACE") + ) + + testthat::expect_silent(result) + testthat::expect_true("lr_stat_df" %in% names(result)) + testthat::expect_type(result$lr_stat_df, "double") + testthat::expect_length(result$lr_stat_df, 2) + testthat::expect_identical(attr(result$lr_stat_df, "label"), "Log-rank Degrees of freedom") +}) + testthat::test_that("coxph_pairwise works with default arguments and no stratification factors", { adtte_f <- tern_ex_adtte %>% dplyr::filter(PARAMCD == "OS") %>% @@ -215,7 +239,7 @@ testthat::test_that("coxph_pairwise works with NA values", { dplyr::filter(PARAMCD == "OS") %>% dplyr::mutate(is_event = FALSE) - testthat::expect_warning(testthat::expect_warning( + testthat::expect_warning(testthat::expect_warning(testthat::expect_warning(testthat::expect_warning( result <- basic_table() %>% split_cols_by( var = "ARMCD", @@ -229,7 +253,7 @@ testthat::test_that("coxph_pairwise works with NA values", { na_str = "empty" ) %>% build_table(df = adtte_f) - )) + )))) testthat::expect_snapshot(result) }) From 2119248cd01b9fe99d1f35f4796700ae66ecd17a Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 6 May 2026 16:42:36 +0200 Subject: [PATCH 02/33] update: NEWS.md --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index c632365bbb..22fbdb0d55 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # tern 0.9.10.9006 +* Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing and added `lr_stat_df` to the parameters return list + # tern 0.9.10 ### Enhancements From ec7d1dd2bd8eb1fed40dff8ff1e28df66e7c41e1 Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Sat, 16 May 2026 21:29:24 +0800 Subject: [PATCH 03/33] simplify df calculation and remove assertion --- R/survival_coxph_pairwise.R | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index 512b2cea54..5772411d85 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -105,17 +105,8 @@ s_coxph_pairwise <- function(df, sum_cox <- summary(cox_fit, conf.int = conf_level, extend = TRUE) original_survdiff <- survival::survdiff(formula_cox, data = df_cox) log_rank_stat <- original_survdiff$chisq - - # See survival::survdiff for the d.f. calculation. - etmp <- if (is.matrix(original_survdiff$exp)) { - apply(original_survdiff$exp, 1, sum) - } else { - original_survdiff$exp - } - log_rank_df <- (sum(1 * (etmp > 0))) - 1 - # Check the consistency of the d.f. with the p-value returned by survival::survdiff. - log_rank_pvalue <- stats::pchisq(log_rank_stat, log_rank_df, lower.tail = FALSE) - checkmate::assert_true(all.equal(log_rank_pvalue, original_survdiff$pvalue)) + log_rank_df <- length(original_survdiff$n) - 1 + log_rank_pvalue <- original_survdiff$pvalue pval <- switch(pval_method, "wald" = sum_cox$waldtest["pvalue"], From cef96bd9fda5909f86ee562f583870b5a996b994 Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Sat, 16 May 2026 21:32:05 +0800 Subject: [PATCH 04/33] add test for p-value consistency --- tests/testthat/test-survival_coxph_pairwise.R | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index 8189886670..1e196a1046 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -102,6 +102,20 @@ testthat::test_that("s_coxph_pairwise works with stratification factors for Log- testthat::expect_type(result$lr_stat_df, "double") testthat::expect_length(result$lr_stat_df, 2) testthat::expect_identical(attr(result$lr_stat_df, "label"), "Log-rank Degrees of freedom") + + # Check the consistency of the d.f. with the p-value returned by survival::survdiff. + log_rank_pvalue <- stats::pchisq( + result$lr_stat_df[1], + result$lr_stat_df[2], + lower.tail = FALSE + ) + original_survdiff <- survival::survdiff( + survival::Surv(AVAL, is_event) ~ ARMCD + strata(SEX, RACE), + data = adtte_f %>% + dplyr::filter(ARMCD %in% c("ARM A", "ARM B")) %>% + droplevels() + ) + testthat::expect_equal(log_rank_pvalue, original_survdiff$pvalue) }) testthat::test_that("coxph_pairwise works with default arguments and no stratification factors", { From 5b0fb90a7c6f9cbf3de1e60b146d4c8d8af2b14a Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Sat, 16 May 2026 21:58:18 +0800 Subject: [PATCH 05/33] use signed LR statistic for calculating one-sided p-value --- R/survival_coxph_pairwise.R | 17 +++++++++-------- tests/testthat/test-survival_coxph_pairwise.R | 4 ++-- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index 5772411d85..d02511249b 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -116,15 +116,16 @@ s_coxph_pairwise <- function(df, # Handle one-sided alternatives. if (alternative != "two.sided") { - right_direction <- if (alternative == "less") { - sum_cox$conf.int[1, 1] < 1 - } else { - sum_cox$conf.int[1, 1] >= 1 - } - pval <- if (right_direction) { - pval / 2 + # Need to calculate the signed log-rank statistic, which is not included + # in the original survdiff output. + otmp <- rowSums(original_survdiff$obs) + etmp <- rowSums(original_survdiff$exp) + signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2]) + + pval <- if (alternative == "less") { + stats::pnorm(signed_lr_stat) } else { - 1 - pval / 2 + stats::pnorm(signed_lr_stat, lower.tail = FALSE) } } diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index 1e196a1046..82b1f1079b 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -253,7 +253,7 @@ testthat::test_that("coxph_pairwise works with NA values", { dplyr::filter(PARAMCD == "OS") %>% dplyr::mutate(is_event = FALSE) - testthat::expect_warning(testthat::expect_warning(testthat::expect_warning(testthat::expect_warning( + testthat::expect_warning(testthat::expect_warning( result <- basic_table() %>% split_cols_by( var = "ARMCD", @@ -267,7 +267,7 @@ testthat::test_that("coxph_pairwise works with NA values", { na_str = "empty" ) %>% build_table(df = adtte_f) - )))) + )) testthat::expect_snapshot(result) }) From 055e674070a6b932f44d84e5acd2ce3f4e9f13ea Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Sat, 16 May 2026 22:08:12 +0800 Subject: [PATCH 06/33] add p-value with alternative to snapshots --- tests/testthat/_snaps/survival_coxph_pairwise.md | 11 ++++++----- tests/testthat/test-survival_coxph_pairwise.R | 3 ++- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/tests/testthat/_snaps/survival_coxph_pairwise.md b/tests/testthat/_snaps/survival_coxph_pairwise.md index 2854fe820b..26f0589398 100644 --- a/tests/testthat/_snaps/survival_coxph_pairwise.md +++ b/tests/testthat/_snaps/survival_coxph_pairwise.md @@ -203,11 +203,12 @@ Code res Output - ARM A ARM B ARM C - ————————————————————————————————————————————————————————————— - Stratified Analysis - Hazard Ratio 1.600 2.049 - 99% CI (0.894, 2.863) (1.092, 3.844) + ARM A ARM B ARM C + ———————————————————————————————————————————————————————————————— + Stratified Analysis + Hazard Ratio 1.600 2.049 + 99% CI (0.894, 2.863) (1.092, 3.844) + p-value (likelihood) 0.0181 0.0014 # coxph_pairwise works with NA values diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index 82b1f1079b..214b6ea03b 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -201,7 +201,8 @@ testthat::test_that("coxph_pairwise works with customized arguments and stratifi var_labels = c("Stratified Analysis"), control = control_coxph(pval_method = "likelihood", conf_level = 0.99), strata = c("SEX", "RACE"), - .stats = c("hr", "hr_ci"), + alternative = "greater", + .stats = c("hr", "hr_ci", "pvalue"), .formats = c(hr = "xx.xxx", hr_ci = "(xx.xxx, xx.xxx)") ) %>% build_table(df = adtte_f) From 3fa708c72c453cba64e4787ccbf74cff41eca248 Mon Sep 17 00:00:00 2001 From: Daniel Sabanes Bove Date: Tue, 19 May 2026 12:20:10 +0800 Subject: [PATCH 07/33] correctly calculate one-sided Wald test p-value, don't allow for likelihood ratio test --- R/survival_coxph_pairwise.R | 55 +++++++++++------ .../_snaps/survival_coxph_pairwise.md | 61 ++++++++++++++++--- tests/testthat/test-survival_coxph_pairwise.R | 54 ++++++++++------ 3 files changed, 121 insertions(+), 49 deletions(-) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index d02511249b..e8aef25ced 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -103,33 +103,50 @@ s_coxph_pairwise <- function(df, ties = ties ) sum_cox <- summary(cox_fit, conf.int = conf_level, extend = TRUE) + original_survdiff <- survival::survdiff(formula_cox, data = df_cox) log_rank_stat <- original_survdiff$chisq log_rank_df <- length(original_survdiff$n) - 1 - log_rank_pvalue <- original_survdiff$pvalue - - pval <- switch(pval_method, - "wald" = sum_cox$waldtest["pvalue"], - "log-rank" = log_rank_pvalue, # pvalue from original log-rank test survival::survdiff() - "likelihood" = sum_cox$logtest["pvalue"] - ) - # Handle one-sided alternatives. - if (alternative != "two.sided") { - # Need to calculate the signed log-rank statistic, which is not included - # in the original survdiff output. - otmp <- rowSums(original_survdiff$obs) - etmp <- rowSums(original_survdiff$exp) - signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2]) - - pval <- if (alternative == "less") { - stats::pnorm(signed_lr_stat) + pval <- if (pval_method == "wald") { + if (alternative == "two.sided") { + sum_cox$waldtest["pvalue"] + } else { + # Need to calculate the signed Wald statistic. + beta_est <- unname(cox_fit$coefficients) + beta_se <- sqrt(cox_fit$var[1, 1]) + signed_wald_stat <- beta_est / beta_se + if (alternative == "less") { + stats::pnorm(signed_wald_stat) + } else { + stats::pnorm(signed_wald_stat, lower.tail = FALSE) + } + } + } else if (pval_method == "log-rank") { + if (alternative == "two.sided") { + original_survdiff$pvalue } else { - stats::pnorm(signed_lr_stat, lower.tail = FALSE) + # Need to calculate the signed log-rank statistic, + # which is not included in the original survdiff output. + otmp <- rowSums(original_survdiff$obs) + etmp <- rowSums(original_survdiff$exp) + signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2]) + + if (alternative == "less") { + stats::pnorm(signed_lr_stat) + } else { + stats::pnorm(signed_lr_stat, lower.tail = FALSE) + } + } + } else if (pval_method == "likelihood") { + if (alternative != "two.sided") { + stop("Likelihood ratio test does not support one-sided alternatives") } + sum_cox$logtest["pvalue"] + } else { + stop("Invalid p-value method specified in control_coxph()") } - list( pvalue = formatters::with_label(unname(pval), paste0("p-value (", pval_method, ")")), lr_stat_df = formatters::with_label(unname(c(log_rank_stat, log_rank_df)), "Log-rank Degrees of freedom"), diff --git a/tests/testthat/_snaps/survival_coxph_pairwise.md b/tests/testthat/_snaps/survival_coxph_pairwise.md index 26f0589398..ecf7cd0216 100644 --- a/tests/testthat/_snaps/survival_coxph_pairwise.md +++ b/tests/testthat/_snaps/survival_coxph_pairwise.md @@ -1,7 +1,7 @@ # s_coxph_pairwise works with default arguments and no stratification factors Code - res + result Output $pvalue [1] 0.09049511 @@ -42,7 +42,7 @@ # s_coxph_pairwise works with customized arguments and no stratification factors Code - res + result Output $pvalue [1] 0.09203863 @@ -80,10 +80,51 @@ [1] "Total events" +# s_coxph_pairwise works with one-sided p-value for Wald test + + Code + result + Output + $pvalue + [1] 0.04601932 + attr(,"label") + [1] "p-value (wald)" + + $lr_stat_df + [1] 2.865544 1.000000 + attr(,"label") + [1] "Log-rank Degrees of freedom" + + $hr + [1] 0.7108557 + attr(,"label") + [1] "Hazard Ratio" + + $hr_ci + [1] 0.5094153 0.9919525 + attr(,"label") + [1] "90% CI" + + $hr_ci_3d + [1] 0.7108557 0.5094153 0.9919525 + attr(,"label") + [1] "Hazard Ratio (90% CI)" + + $n_tot + [1] 142 + attr(,"label") + [1] "Total n" + + $n_tot_events + [1] 101 + attr(,"label") + [1] "Total events" + + # s_coxph_pairwise works with default arguments and stratification factors Code - res + result Output $pvalue [1] 0.03613543 @@ -124,7 +165,7 @@ # s_coxph_pairwise works with customized arguments and stratification factors Code - res + result Output $pvalue [1] 0.03764119 @@ -203,12 +244,12 @@ Code res Output - ARM A ARM B ARM C - ———————————————————————————————————————————————————————————————— - Stratified Analysis - Hazard Ratio 1.600 2.049 - 99% CI (0.894, 2.863) (1.092, 3.844) - p-value (likelihood) 0.0181 0.0014 + ARM A ARM B ARM C + —————————————————————————————————————————————————————————————— + Stratified Analysis + Hazard Ratio 1.600 2.049 + 99% CI (0.894, 2.863) (1.092, 3.844) + p-value (log-rank) 0.0181 0.0014 # coxph_pairwise works with NA values diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index 214b6ea03b..e8d66464bd 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -5,17 +5,16 @@ testthat::test_that("s_coxph_pairwise works with default arguments and no strati df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") - result <- s_coxph_pairwise( + result <- testthat::expect_silent(s_coxph_pairwise( df = df, .ref_group = df_ref, .in_ref_col = FALSE, .var = "AVAL", is_event = "is_event", strata = NULL - ) + )) - res <- testthat::expect_silent(result) - testthat::expect_snapshot(res) + testthat::expect_snapshot(result) }) testthat::test_that("s_coxph_pairwise works with customized arguments and no stratification factors", { @@ -25,7 +24,7 @@ testthat::test_that("s_coxph_pairwise works with customized arguments and no str df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") - result <- s_coxph_pairwise( + result <- testthat::expect_silent(s_coxph_pairwise( df = df, .ref_group = df_ref, .in_ref_col = FALSE, @@ -33,10 +32,28 @@ testthat::test_that("s_coxph_pairwise works with customized arguments and no str is_event = "is_event", strata = NULL, control = control_coxph(pval_method = "wald", ties = "breslow", conf_level = 0.9) - ) + )) + testthat::expect_snapshot(result) +}) - res <- testthat::expect_silent(result) - testthat::expect_snapshot(res) +testthat::test_that("s_coxph_pairwise works with one-sided p-value for Wald test", { + adtte_f <- tern_ex_adtte %>% + dplyr::filter(PARAMCD == "OS") %>% + dplyr::mutate(is_event = CNSR == 0) + df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") + df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") + + result <- testthat::expect_silent(s_coxph_pairwise( + df = df, + .ref_group = df_ref, + .in_ref_col = FALSE, + .var = "AVAL", + is_event = "is_event", + strata = NULL, + control = control_coxph(pval_method = "wald", ties = "breslow", conf_level = 0.9), + alternative = "less" + )) + testthat::expect_snapshot(result) }) testthat::test_that("s_coxph_pairwise works with default arguments and stratification factors", { @@ -46,17 +63,16 @@ testthat::test_that("s_coxph_pairwise works with default arguments and stratific df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") - result <- s_coxph_pairwise( + result <- testthat::expect_silent(s_coxph_pairwise( df = df, .ref_group = df_ref, .in_ref_col = FALSE, .var = "AVAL", is_event = "is_event", strata = c("SEX", "RACE") - ) + )) - res <- testthat::expect_silent(result) - testthat::expect_snapshot(res) + testthat::expect_snapshot(result) }) testthat::test_that("s_coxph_pairwise works with customized arguments and stratification factors", { @@ -66,7 +82,7 @@ testthat::test_that("s_coxph_pairwise works with customized arguments and strati df <- adtte_f %>% dplyr::filter(ARMCD == "ARM A") df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") - result <- s_coxph_pairwise( + result <- testthat::expect_silent(s_coxph_pairwise( df = df, .ref_group = df_ref, .in_ref_col = FALSE, @@ -74,10 +90,9 @@ testthat::test_that("s_coxph_pairwise works with customized arguments and strati is_event = "is_event", strata = c("SEX", "RACE"), control = control_coxph(pval_method = "wald", ties = "breslow", conf_level = 0.9) - ) + )) - res <- testthat::expect_silent(result) - testthat::expect_snapshot(res) + testthat::expect_snapshot(result) }) testthat::test_that("s_coxph_pairwise works with stratification factors for Log-Rank test", { @@ -88,16 +103,15 @@ testthat::test_that("s_coxph_pairwise works with stratification factors for Log- df_ref <- adtte_f %>% dplyr::filter(ARMCD == "ARM B") # default control uses pval_method = "log-rank" - result <- s_coxph_pairwise( + result <- testthat::expect_silent(s_coxph_pairwise( df = df, .ref_group = df_ref, .in_ref_col = FALSE, .var = "AVAL", is_event = "is_event", strata = c("SEX", "RACE") - ) + )) - testthat::expect_silent(result) testthat::expect_true("lr_stat_df" %in% names(result)) testthat::expect_type(result$lr_stat_df, "double") testthat::expect_length(result$lr_stat_df, 2) @@ -199,7 +213,7 @@ testthat::test_that("coxph_pairwise works with customized arguments and stratifi vars = "AVAL", is_event = "is_event", var_labels = c("Stratified Analysis"), - control = control_coxph(pval_method = "likelihood", conf_level = 0.99), + control = control_coxph(pval_method = "log-rank", conf_level = 0.99), strata = c("SEX", "RACE"), alternative = "greater", .stats = c("hr", "hr_ci", "pvalue"), From 981e7408e6e9844ae4b503c37be0ee29d0adb82d Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 19 May 2026 14:44:45 +0000 Subject: [PATCH 08/33] two separate bullet points --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 22fbdb0d55..62712eb103 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,8 @@ # tern 0.9.10.9006 -* Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing and added `lr_stat_df` to the parameters return list +### Enhancements +* Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. +* Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`. # tern 0.9.10 From 2b68263dba57ddad447284014f11fe35f6d97e64 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 19 May 2026 14:48:52 +0000 Subject: [PATCH 09/33] alternative in control_coxph as per API design --- R/control_survival.R | 9 +++++++-- R/survival_coxph_pairwise.R | 6 ++++-- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/R/control_survival.R b/R/control_survival.R index a54346fb82..d5ff7ab265 100644 --- a/R/control_survival.R +++ b/R/control_survival.R @@ -10,18 +10,23 @@ #' Default method is `"log-rank"`, can also be set to `"wald"` or `"likelihood"`. #' @param ties (`string`)\cr string specifying the method for tie handling. Default is `"efron"`, #' can also be set to `"breslow"` or `"exact"`. See more in [survival::coxph()]. +#' @param alternative (`string`)\cr alternative hypothesis for the p-value test. Default is `"two.sided"`, +#' can also be set to `"less"` or `"greater"` for one-sided testing. Note that one-sided testing is not +#' supported when `pval_method = "likelihood"`. #' #' @return A list of components with the same names as the arguments. #' #' @export control_coxph <- function(pval_method = c("log-rank", "wald", "likelihood"), ties = c("efron", "breslow", "exact"), - conf_level = 0.95) { + conf_level = 0.95, + alternative = c("two.sided", "less", "greater")) { pval_method <- match.arg(pval_method) ties <- match.arg(ties) + alternative <- match.arg(alternative) assert_proportion_value(conf_level) - list(pval_method = pval_method, ties = ties, conf_level = conf_level) + list(pval_method = pval_method, ties = ties, conf_level = conf_level, alternative = alternative) } #' Control function for `survfit` models for survival time diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index e8aef25ced..1132646768 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -20,6 +20,9 @@ #' * `ties` (`string`)\cr specifying the method for tie handling. Default is `"efron"`, #' can also be set to `"breslow"` or `"exact"`. See more in [survival::coxph()]. #' * `conf_level` (`proportion`)\cr confidence level of the interval for HR. +#' * `alternative` (`string`)\cr alternative hypothesis for the p-value test. Default is `"two.sided"`, +#' can also be set to `"less"` or `"greater"` for one-sided testing. Note that one-sided testing is not +#' supported when `pval_method = "likelihood"`. #' @param .stats (`character`)\cr statistics to select for the table. #' #' Options are: ``r shQuote(get_stats("coxph_pairwise"), type = "sh")`` @@ -47,7 +50,6 @@ s_coxph_pairwise <- function(df, strata = NULL, strat = lifecycle::deprecated(), control = control_coxph(), - alternative = c("two.sided", "less", "greater"), ...) { if (lifecycle::is_present(strat)) { lifecycle::deprecate_warn("0.9.4", "s_coxph_pairwise(strat)", "s_coxph_pairwise(strata)") @@ -58,11 +60,11 @@ s_coxph_pairwise <- function(df, checkmate::assert_numeric(df[[.var]]) checkmate::assert_logical(df[[is_event]]) assert_df_with_variables(df, list(tte = .var, is_event = is_event)) - alternative <- match.arg(alternative) pval_method <- control$pval_method ties <- control$ties conf_level <- control$conf_level + alternative <- control$alternative if (.in_ref_col) { return( From 65cd46c8a8ddf6dfa7317c23db6ea089b0041903 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 19 May 2026 14:56:26 +0000 Subject: [PATCH 10/33] added lr_stat_df to utils_default_stats_formats_labels.R --- R/utils_default_stats_formats_labels.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 87da529733..937abc8892 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -574,7 +574,7 @@ tern_default_stats <- list( count_patients_with_event = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"), count_patients_with_flags = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"), count_values = c("n", "count", "count_fraction", "count_fraction_fixed_dp", "n_blq"), - coxph_pairwise = c("pvalue", "hr", "hr_ci", "n_tot", "n_tot_events"), + coxph_pairwise = c("pvalue", "hr", "hr_ci", "hr_ci_3d", "lr_stat_df", "n_tot", "n_tot_events"), estimate_incidence_rate = c("person_years", "n_events", "rate", "rate_ci", "n_unique", "n_rate"), estimate_multinomial_response = c("n_prop", "prop_ci"), estimate_odds_ratio = c("or_ci", "n_tot"), @@ -623,6 +623,7 @@ tern_default_formats <- c( hr = list(format_extreme_values(2L)), hr_ci = "(xx.xx, xx.xx)", hr_ci_3d = "xx.xx (xx.xx - xx.xx)", + lr_stat_df = "xx.xx (xx.)", iqr = "xx.x", lsmean = "xx.xx", lsmean_diff = "xx.xx", From cca28200aff553894f9a0688420bf3a1e70126c1 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 19 May 2026 15:15:57 +0000 Subject: [PATCH 11/33] update: rerun docs --- man/control_coxph.Rd | 7 ++++++- man/extract_survival_subgroups.Rd | 3 +++ man/h_survival_duration_subgroups.Rd | 3 +++ man/survival_coxph_pairwise.Rd | 9 ++++----- 4 files changed, 16 insertions(+), 6 deletions(-) diff --git a/man/control_coxph.Rd b/man/control_coxph.Rd index ca615965a7..b14b49613a 100644 --- a/man/control_coxph.Rd +++ b/man/control_coxph.Rd @@ -7,7 +7,8 @@ control_coxph( pval_method = c("log-rank", "wald", "likelihood"), ties = c("efron", "breslow", "exact"), - conf_level = 0.95 + conf_level = 0.95, + alternative = c("two.sided", "less", "greater") ) } \arguments{ @@ -18,6 +19,10 @@ Default method is \code{"log-rank"}, can also be set to \code{"wald"} or \code{" can also be set to \code{"breslow"} or \code{"exact"}. See more in \code{\link[survival:coxph]{survival::coxph()}}.} \item{conf_level}{(\code{proportion})\cr confidence level of the interval.} + +\item{alternative}{(\code{string})\cr alternative hypothesis for the p-value test. Default is \code{"two.sided"}, +can also be set to \code{"less"} or \code{"greater"} for one-sided testing. Note that one-sided testing is not +supported when \code{pval_method = "likelihood"}.} } \value{ A list of components with the same names as the arguments. diff --git a/man/extract_survival_subgroups.Rd b/man/extract_survival_subgroups.Rd index 86f73e6d53..efe1176570 100644 --- a/man/extract_survival_subgroups.Rd +++ b/man/extract_survival_subgroups.Rd @@ -30,6 +30,9 @@ method is \code{"log-rank"} which comes from \code{\link[survival:survdiff]{surv \item \code{ties} (\code{string})\cr specifying the method for tie handling. Default is \code{"efron"}, can also be set to \code{"breslow"} or \code{"exact"}. See more in \code{\link[survival:coxph]{survival::coxph()}}. \item \code{conf_level} (\code{proportion})\cr confidence level of the interval for HR. +\item \code{alternative} (\code{string})\cr alternative hypothesis for the p-value test. Default is \code{"two.sided"}, +can also be set to \code{"less"} or \code{"greater"} for one-sided testing. Note that one-sided testing is not +supported when \code{pval_method = "likelihood"}. }} \item{label_all}{(\code{string})\cr label for the total population analysis.} diff --git a/man/h_survival_duration_subgroups.Rd b/man/h_survival_duration_subgroups.Rd index 76d0a41ec7..0932cddbd7 100644 --- a/man/h_survival_duration_subgroups.Rd +++ b/man/h_survival_duration_subgroups.Rd @@ -55,6 +55,9 @@ method is \code{"log-rank"} which comes from \code{\link[survival:survdiff]{surv \item \code{ties} (\code{string})\cr specifying the method for tie handling. Default is \code{"efron"}, can also be set to \code{"breslow"} or \code{"exact"}. See more in \code{\link[survival:coxph]{survival::coxph()}}. \item \code{conf_level} (\code{proportion})\cr confidence level of the interval for HR. +\item \code{alternative} (\code{string})\cr alternative hypothesis for the p-value test. Default is \code{"two.sided"}, +can also be set to \code{"less"} or \code{"greater"} for one-sided testing. Note that one-sided testing is not +supported when \code{pval_method = "likelihood"}. }} } \value{ diff --git a/man/survival_coxph_pairwise.Rd b/man/survival_coxph_pairwise.Rd index 02555aeb32..90ecf05b09 100644 --- a/man/survival_coxph_pairwise.Rd +++ b/man/survival_coxph_pairwise.Rd @@ -34,7 +34,6 @@ s_coxph_pairwise( strata = NULL, strat = lifecycle::deprecated(), control = control_coxph(), - alternative = c("two.sided", "less", "greater"), ... ) @@ -64,6 +63,9 @@ method is \code{"log-rank"} which comes from \code{\link[survival:survdiff]{surv \item \code{ties} (\code{string})\cr specifying the method for tie handling. Default is \code{"efron"}, can also be set to \code{"breslow"} or \code{"exact"}. See more in \code{\link[survival:coxph]{survival::coxph()}}. \item \code{conf_level} (\code{proportion})\cr confidence level of the interval for HR. +\item \code{alternative} (\code{string})\cr alternative hypothesis for the p-value test. Default is \code{"two.sided"}, +can also be set to \code{"less"} or \code{"greater"} for one-sided testing. Note that one-sided testing is not +supported when \code{pval_method = "likelihood"}. }} \item{na_str}{(\code{string})\cr string used to replace all \code{NA} or empty values in the output.} @@ -83,7 +85,7 @@ times, to avoid warnings from \code{rtables}.} \item{.stats}{(\code{character})\cr statistics to select for the table. -Options are: \verb{'pvalue', 'hr', 'hr_ci', 'n_tot', 'n_tot_events'}} +Options are: \verb{'pvalue', 'hr', 'hr_ci', 'hr_ci_3d', 'lr_stat_df', 'n_tot', 'n_tot_events'}} \item{.stat_names}{(\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}.} @@ -108,9 +110,6 @@ by a statistics function.} \item{is_event}{(\code{flag})\cr \code{TRUE} if event, \code{FALSE} if time to event is censored.} \item{strat}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Please use the \code{strata} argument instead.} - -\item{alternative}{(\code{string})\cr whether \code{two.sided}, or one-sided \code{less} or \code{greater} p-value -should be displayed.} } \value{ \itemize{ From 6233fd7043debf41a22406ac4298ce8b868620af Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 19 May 2026 15:31:12 +0000 Subject: [PATCH 12/33] update: update test accordingly to updates --- tests/testthat/test-survival_coxph_pairwise.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-survival_coxph_pairwise.R b/tests/testthat/test-survival_coxph_pairwise.R index e8d66464bd..66e7170ed8 100644 --- a/tests/testthat/test-survival_coxph_pairwise.R +++ b/tests/testthat/test-survival_coxph_pairwise.R @@ -50,8 +50,7 @@ testthat::test_that("s_coxph_pairwise works with one-sided p-value for Wald test .var = "AVAL", is_event = "is_event", strata = NULL, - control = control_coxph(pval_method = "wald", ties = "breslow", conf_level = 0.9), - alternative = "less" + control = control_coxph(pval_method = "wald", ties = "breslow", conf_level = 0.9, alternative = "less") )) testthat::expect_snapshot(result) }) @@ -213,9 +212,8 @@ testthat::test_that("coxph_pairwise works with customized arguments and stratifi vars = "AVAL", is_event = "is_event", var_labels = c("Stratified Analysis"), - control = control_coxph(pval_method = "log-rank", conf_level = 0.99), + control = control_coxph(pval_method = "log-rank", conf_level = 0.99, alternative = "greater"), strata = c("SEX", "RACE"), - alternative = "greater", .stats = c("hr", "hr_ci", "pvalue"), .formats = c(hr = "xx.xxx", hr_ci = "(xx.xxx, xx.xxx)") ) %>% From 8ce8bf04321c6eb6539861b27294bda57ffb426c Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 29 May 2026 13:55:04 +0000 Subject: [PATCH 13/33] feat: add lsmean_se/lsmean_ci/lsmean_diffci stats, weights_emmeans param, and export s_ancova() --- NAMESPACE | 1 + NEWS.md | 3 + R/summarize_ancova.R | 107 +++++++++++++++------- R/utils_default_stats_formats_labels.R | 6 +- man/summarize_ancova.Rd | 8 +- tests/testthat/_snaps/summarize_ancova.md | 30 ++++++ tests/testthat/test-summarize_ancova.R | 86 +++++++++++++++++ 7 files changed, 204 insertions(+), 37 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 07530394a7..3a32db7308 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -265,6 +265,7 @@ export(range_noinf) export(reapply_varlabels) export(ref_group_position) export(rtable2gg) +export(s_ancova) export(s_bland_altman) export(s_compare) export(s_count_occurrences) diff --git a/NEWS.md b/NEWS.md index 37f55a1ece..0cd2164cd3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,11 +2,14 @@ ### Miscellaneous * Updated `roxygen2` to 8.0.0 and added `@exportS3Method` tags for S3 methods in `decorate_grob.R` and `utils_grid.R`. +* Converted `s_ancova()`to exported functions. ### Enhancements * Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. * Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`. * Added `uncond_exact_diff` method to `estimate_proportion_diff()` for the unconditional exact confidence interval for the difference in proportions by inverting one-sided tail tests over a nuisance parameter. +* Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`. +* Added `weights_emmeans` parameter on `s_ancova()`. # tern 0.9.10 diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index f740c43e46..cd131749fc 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -101,16 +101,20 @@ h_ancova <- function(.var, #' of the investigated linear model. #' #' @return -#' * `s_ancova()` returns a named list of 5 statistics: +#' * `s_ancova()` returns a named list of 8 statistics: #' * `n`: Count of complete sample size for the group. #' * `lsmean`: Estimated marginal means in the group. +#' * `lsmean_se`: Adjusted mean with standard error as a 2-element vector `c(emmean, SE)`. +#' * `lsmean_ci`: Adjusted mean with confidence interval as a 3-element vector `c(emmean, lower.CL, upper.CL)`. #' * `lsmean_diff`: Difference in estimated marginal means in comparison to the reference group. #' If working with the reference group, this will be empty. #' * `lsmean_diff_ci`: Confidence level for difference in estimated marginal means in comparison #' to the reference group. +#' * `lsmean_diffci`: Difference in adjusted means with confidence interval as a 3-element vector +#' `c(estimate, lower.CL, upper.CL)`. If working with the reference group, this will be `NA`. #' * `pval`: p-value (not adjusted for multiple comparisons). #' -#' @keywords internal +#' @export s_ancova <- function(df, .var, .df_row, @@ -150,63 +154,98 @@ s_ancova <- function(df, # convert characters selected in interaction_y into the numeric order interaction_y <- which(sum_fit_level[[interaction_item]] == interaction_y) sum_fit_level <- sum_fit_level[interaction_y, ] - # if interaction is called, reset the index - ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) - ref_key <- tail(ref_key, n = 1) - ref_key <- (interaction_y - 1) * length(unique(.df_row[[arm]])) + ref_key } else { y <- df[[.var]] - # Get the index of the ref arm when interaction is not called - ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) - ref_key <- tail(ref_key, n = 1) } if (.in_ref_col) { list( n = length(y[!is.na(y)]), lsmean = formatters::with_label(sum_fit_level$emmean, "Adjusted Mean"), + lsmean_se = formatters::with_label( + c(sum_fit_level$emmean, sum_fit_level$SE), + "Adjusted Mean (SE)" + ), + lsmean_ci = formatters::with_label( + c(sum_fit_level$emmean, sum_fit_level$lower.CL, sum_fit_level$upper.CL), + f_conf_level(conf_level) + ), lsmean_diff = formatters::with_label(numeric(), "Difference in Adjusted Means"), lsmean_diff_ci = formatters::with_label(numeric(), f_conf_level(conf_level)), + lsmean_diffci = formatters::with_label( + c(NA_real_, NA_real_, NA_real_), + "Difference in Adjusted Means (95% CI)" + ), pval = formatters::with_label(numeric(), "p-value") ) } else { - # Estimate the differences between the marginal means. - emmeans_contrasts <- emmeans::contrast( - emmeans_fit, - # Compare all arms versus the control arm. - method = "trt.vs.ctrl", - # Take the arm factor from .ref_group as the control arm. - ref = ref_key, - level = conf_level - ) - sum_contrasts <- summary( - emmeans_contrasts, - # Derive confidence intervals, t-tests and p-values. - infer = TRUE, - # Do not adjust the p-values for multiplicity. - adjust = "none" - ) + if (!is.null(.ref_group)) { + # Compute ref_key — index of the reference arm in the emmeans grid + if (interaction_y != FALSE) { + ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) + ref_key <- tail(ref_key, n = 1) + ref_key <- (interaction_y - 1) * length(unique(.df_row[[arm]])) + ref_key + } else { + ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) + ref_key <- tail(ref_key, n = 1) + } + # Estimate the differences between the marginal means. + emmeans_contrasts <- emmeans::contrast( + emmeans_fit, + # Compare all arms versus the control arm. + method = "trt.vs.ctrl", + # Take the arm factor from .ref_group as the control arm. + ref = ref_key, + level = conf_level + ) + sum_contrasts <- summary( + emmeans_contrasts, + # Derive confidence intervals, t-tests and p-values. + infer = TRUE, + # Do not adjust the p-values for multiplicity. + adjust = "none" + ) - contrast_lvls <- gsub( - "^\\(|\\)$", "", gsub(paste0(" - \\(*", .ref_group[[arm]][1], ".*"), "", sum_contrasts$contrast) - ) - if (!is.null(interaction_item)) { - sum_contrasts_level <- sum_contrasts[grepl(sum_level, contrast_lvls, fixed = TRUE), ] + contrast_lvls <- gsub( + "^\\(|\\)$", "", gsub(paste0(" - \\(*", .ref_group[[arm]][1], ".*"), "", sum_contrasts$contrast) + ) + if (!is.null(interaction_item)) { + sum_contrasts_level <- sum_contrasts[grepl(sum_level, contrast_lvls, fixed = TRUE), ] + } else { + sum_contrasts_level <- sum_contrasts[sum_level == contrast_lvls, ] + } + if (interaction_y != FALSE) { + sum_contrasts_level <- sum_contrasts_level[interaction_y, ] + } } else { - sum_contrasts_level <- sum_contrasts[sum_level == contrast_lvls, ] - } - if (interaction_y != FALSE) { - sum_contrasts_level <- sum_contrasts_level[interaction_y, ] + sum_contrasts_level <- list( + estimate = NA_real_, + lower.CL = NA_real_, + upper.CL = NA_real_, + p.value = NA_real_ + ) } list( n = length(y[!is.na(y)]), lsmean = formatters::with_label(sum_fit_level$emmean, "Adjusted Mean"), + lsmean_se = formatters::with_label( + c(sum_fit_level$emmean, sum_fit_level$SE), + "Adjusted Mean (SE)" + ), + lsmean_ci = formatters::with_label( + c(sum_fit_level$emmean, sum_fit_level$lower.CL, sum_fit_level$upper.CL), + f_conf_level(conf_level) + ), lsmean_diff = formatters::with_label(sum_contrasts_level$estimate, "Difference in Adjusted Means"), lsmean_diff_ci = formatters::with_label( c(sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL), f_conf_level(conf_level) ), + lsmean_diffci = formatters::with_label( + c(sum_contrasts_level$estimate, sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL), + "Difference in Adjusted Means (95% CI)" + ), pval = formatters::with_label(sum_contrasts_level$p.value, "p-value") ) } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 937abc8892..63f8e15776 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -580,7 +580,8 @@ tern_default_stats <- list( estimate_odds_ratio = c("or_ci", "n_tot"), estimate_proportion = c("n_prop", "prop_ci"), estimate_proportion_diff = c("diff", "diff_ci"), - summarize_ancova = c("n", "lsmean", "lsmean_diff", "lsmean_diff_ci", "pval"), + summarize_ancova = c("n", "lsmean", "lsmean_se", "lsmean_ci", + "lsmean_diff", "lsmean_diff_ci", "lsmean_diffci", "pval"), summarize_coxreg = c("n", "hr", "ci", "pval", "pval_inter"), summarize_glm_count = c("n", "rate", "rate_ci", "rate_ratio", "rate_ratio_ci", "pval"), summarize_num_patients = c("unique", "nonunique", "unique_count"), @@ -626,8 +627,11 @@ tern_default_formats <- c( lr_stat_df = "xx.xx (xx.)", iqr = "xx.x", lsmean = "xx.xx", + lsmean_ci = "xx.xx (xx.xx - xx.xx)", lsmean_diff = "xx.xx", lsmean_diff_ci = "(xx.xx, xx.xx)", + lsmean_diffci = "xx.xx (xx.xx - xx.xx)", + lsmean_se = "xx.xx (xx.xx)", mad = "xx.x", max = "xx.x", mean = "xx.x", diff --git a/man/summarize_ancova.Rd b/man/summarize_ancova.Rd index 2b246a9b88..5484c8d293 100644 --- a/man/summarize_ancova.Rd +++ b/man/summarize_ancova.Rd @@ -91,7 +91,7 @@ times, to avoid warnings from \code{rtables}.} \item{.stats}{(\code{character})\cr statistics to select for the table. -Options are: \verb{'n', 'lsmean', 'lsmean_diff', 'lsmean_diff_ci', 'pval'}} +Options are: \verb{'n', 'lsmean', 'lsmean_se', 'lsmean_ci', 'lsmean_diff', 'lsmean_diff_ci', 'lsmean_diffci', 'pval'}} \item{.stat_names}{(\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:as_result_df]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} @@ -123,14 +123,18 @@ the statistics from \code{s_ancova()} to the table layout. } \itemize{ -\item \code{s_ancova()} returns a named list of 5 statistics: +\item \code{s_ancova()} returns a named list of 8 statistics: \itemize{ \item \code{n}: Count of complete sample size for the group. \item \code{lsmean}: Estimated marginal means in the group. +\item \code{lsmean_se}: Adjusted mean with standard error as a 2-element vector \code{c(emmean, SE)}. +\item \code{lsmean_ci}: Adjusted mean with confidence interval as a 3-element vector \code{c(emmean, lower.CL, upper.CL)}. \item \code{lsmean_diff}: Difference in estimated marginal means in comparison to the reference group. If working with the reference group, this will be empty. \item \code{lsmean_diff_ci}: Confidence level for difference in estimated marginal means in comparison to the reference group. +\item \code{lsmean_diffci}: Difference in adjusted means with confidence interval as a 3-element vector +\code{c(estimate, lower.CL, upper.CL)}. If working with the reference group, this will be \code{NA}. \item \code{pval}: p-value (not adjusted for multiple comparisons). } } diff --git a/tests/testthat/_snaps/summarize_ancova.md b/tests/testthat/_snaps/summarize_ancova.md index c9f1e45fd9..cb821b2390 100644 --- a/tests/testthat/_snaps/summarize_ancova.md +++ b/tests/testthat/_snaps/summarize_ancova.md @@ -23,6 +23,16 @@ attr(,"label") [1] "Adjusted Mean" + $lsmean_se + [1] 5.71740917 0.06680849 + attr(,"label") + [1] "Adjusted Mean (SE)" + + $lsmean_ci + [1] 5.717409 5.542996 5.891823 + attr(,"label") + [1] "99% CI" + $lsmean_diff [1] -0.4374138 attr(,"label") @@ -33,6 +43,11 @@ attr(,"label") [1] "99% CI" + $lsmean_diffci + [1] -0.4374138 -1.4268150 0.5519873 + attr(,"label") + [1] "Difference in Adjusted Means (95% CI)" + $pval [1] 0.2503574 attr(,"label") @@ -52,6 +67,16 @@ attr(,"label") [1] "Adjusted Mean" + $lsmean_se + [1] 4.36264203 0.08598191 + attr(,"label") + [1] "Adjusted Mean (SE)" + + $lsmean_ci + [1] 4.362642 4.192651 4.532633 + attr(,"label") + [1] "95% CI" + $lsmean_diff numeric(0) attr(,"label") @@ -62,6 +87,11 @@ attr(,"label") [1] "95% CI" + $lsmean_diffci + [1] NA NA NA + attr(,"label") + [1] "Difference in Adjusted Means (95% CI)" + $pval numeric(0) attr(,"label") diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index df6bc820f4..3d14ff85c1 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -231,3 +231,89 @@ testthat::test_that("summarize_ancova works with irregular arm levels", { res <- testthat::expect_silent(result3) testthat::expect_snapshot(res) }) + +testthat::test_that("s_ancova returns lsmean_se, lsmean_ci, lsmean_diffci for non-ref column", { + df_col <- iris %>% dplyr::filter(Species == "versicolor") + df_ref <- iris %>% dplyr::filter(Species == "setosa") + result <- s_ancova( + df = df_col, + .var = "Sepal.Length", + .df_row = iris, + variables = list(arm = "Species", covariates = "Petal.Length"), + .ref_group = df_ref, + .in_ref_col = FALSE, + conf_level = 0.95 + ) + + testthat::expect_length(result$lsmean_se, 2) + testthat::expect_length(result$lsmean_ci, 3) + testthat::expect_length(result$lsmean_diffci, 3) + testthat::expect_equal(as.numeric(result$lsmean_se[[1]]), as.numeric(result$lsmean)) + testthat::expect_equal(as.numeric(result$lsmean_diffci[[1]]), as.numeric(result$lsmean_diff)) + testthat::expect_equal(as.numeric(result$lsmean_diffci[2:3]), as.numeric(result$lsmean_diff_ci)) +}) + +testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { + df_ref <- iris %>% dplyr::filter(Species == "setosa") + result <- s_ancova( + df = df_ref, + .var = "Sepal.Length", + .df_row = iris, + variables = list(arm = "Species", covariates = "Petal.Length"), + .ref_group = df_ref, + .in_ref_col = TRUE, + conf_level = 0.95 + ) + + testthat::expect_length(result$lsmean_se, 2) + testthat::expect_length(result$lsmean_ci, 3) + testthat::expect_true(all(is.na(result$lsmean_diffci))) + testthat::expect_length(result$lsmean_diff, 0) +}) + +testthat::test_that("s_ancova returns NA diffs when .ref_group is NULL", { + df_col <- iris %>% dplyr::filter(Species == "versicolor") + result <- s_ancova( + df = df_col, + .var = "Sepal.Length", + .df_row = iris, + variables = list(arm = "Species", covariates = "Petal.Length"), + .ref_group = NULL, + .in_ref_col = FALSE, + conf_level = 0.95 + ) + + testthat::expect_true(is.na(result$lsmean_diff)) + testthat::expect_true(all(is.na(result$lsmean_diff_ci))) + testthat::expect_true(all(is.na(result$lsmean_diffci))) + testthat::expect_true(is.na(result$pval)) +}) + +testthat::test_that("s_ancova respects weights_emmeans parameter", { + df_col <- iris %>% dplyr::filter(Species == "versicolor") + df_ref <- iris %>% dplyr::filter(Species == "setosa") + + result_null <- s_ancova( + df = df_col, + .var = "Sepal.Length", + .df_row = iris, + variables = list(arm = "Species", covariates = NULL), + .ref_group = df_ref, + .in_ref_col = FALSE, + conf_level = 0.95, + weights_emmeans = NULL + ) + result_cf <- s_ancova( + df = df_col, + .var = "Sepal.Length", + .df_row = iris, + variables = list(arm = "Species", covariates = NULL), + .ref_group = df_ref, + .in_ref_col = FALSE, + conf_level = 0.95, + weights_emmeans = "counterfactual" + ) + + # With no covariates, proportional and counterfactual weights give the same emmeans + testthat::expect_equal(result_null$lsmean, result_cf$lsmean, tolerance = 1e-6) +}) From 25f4a6af92dfe644f560fcb7d54d1ec49c7bfdaf Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 29 May 2026 13:55:32 +0000 Subject: [PATCH 14/33] fix: lints --- R/survival_coxph_pairwise.R | 46 ++++++++++++++++++------------------- 1 file changed, 23 insertions(+), 23 deletions(-) diff --git a/R/survival_coxph_pairwise.R b/R/survival_coxph_pairwise.R index 1132646768..96dc41e0d1 100644 --- a/R/survival_coxph_pairwise.R +++ b/R/survival_coxph_pairwise.R @@ -112,37 +112,37 @@ s_coxph_pairwise <- function(df, pval <- if (pval_method == "wald") { if (alternative == "two.sided") { - sum_cox$waldtest["pvalue"] + sum_cox$waldtest["pvalue"] } else { - # Need to calculate the signed Wald statistic. - beta_est <- unname(cox_fit$coefficients) - beta_se <- sqrt(cox_fit$var[1, 1]) - signed_wald_stat <- beta_est / beta_se - if (alternative == "less") { - stats::pnorm(signed_wald_stat) - } else { - stats::pnorm(signed_wald_stat, lower.tail = FALSE) - } - } + # Need to calculate the signed Wald statistic. + beta_est <- unname(cox_fit$coefficients) + beta_se <- sqrt(cox_fit$var[1, 1]) + signed_wald_stat <- beta_est / beta_se + if (alternative == "less") { + stats::pnorm(signed_wald_stat) + } else { + stats::pnorm(signed_wald_stat, lower.tail = FALSE) + } + } } else if (pval_method == "log-rank") { if (alternative == "two.sided") { - original_survdiff$pvalue + original_survdiff$pvalue } else { - # Need to calculate the signed log-rank statistic, - # which is not included in the original survdiff output. - otmp <- rowSums(original_survdiff$obs) - etmp <- rowSums(original_survdiff$exp) - signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2]) + # Need to calculate the signed log-rank statistic, + # which is not included in the original survdiff output. + otmp <- rowSums(original_survdiff$obs) + etmp <- rowSums(original_survdiff$exp) + signed_lr_stat <- (otmp[2] - etmp[2]) / sqrt(original_survdiff$var[2, 2]) - if (alternative == "less") { - stats::pnorm(signed_lr_stat) - } else { - stats::pnorm(signed_lr_stat, lower.tail = FALSE) - } + if (alternative == "less") { + stats::pnorm(signed_lr_stat) + } else { + stats::pnorm(signed_lr_stat, lower.tail = FALSE) + } } } else if (pval_method == "likelihood") { if (alternative != "two.sided") { - stop("Likelihood ratio test does not support one-sided alternatives") + stop("Likelihood ratio test does not support one-sided alternatives") } sum_cox$logtest["pvalue"] } else { From 630243aece8dc126ea965c515ddca20c5a46f5f5 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 29 May 2026 14:21:14 +0000 Subject: [PATCH 15/33] wip --- NEWS.md | 1 + R/formatting_functions.R | 29 +++++++++++ R/survival_time.R | 9 ++++ R/utils_default_stats_formats_labels.R | 5 +- tests/testthat/test-survival_time.R | 66 ++++++++++++++++++++++++++ 5 files changed, 109 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 62712eb103..fdfab34842 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ ### Enhancements * Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. * Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`. +* Added `range_with_cens_info` statistic to `s_surv_time()`. # tern 0.9.10 diff --git a/R/formatting_functions.R b/R/formatting_functions.R index f18409810c..01642c0fa9 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -573,3 +573,32 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { } .formats } + +#' Format range with censoring indicators +#' +#' @description `r lifecycle::badge("stable")` +#' +#' Formats a survival time range where the minimum and/or maximum may be a censored observation. +#' A `+` suffix is appended to a bound when the corresponding censoring flag is `TRUE`. +#' +#' @param x (`numeric(4)`)\\cr vector of the form `c(min, max, lower_censored, upper_censored)`, +#' where `lower_censored` and `upper_censored` are `0`/`1` (or `FALSE`/`TRUE`) flags. +#' @param ... not used. Required for `rtables` interface. +#' +#' @return A string in the format `"min to max"`, with `+` appended to `min` and/or `max` +#' when the corresponding censoring flag is non-zero. +#' +#' @examples +#' format_range_cens(c(1.2, 8.5, 0, 0)) +#' format_range_cens(c(1.2, 8.5, 1, 0)) +#' format_range_cens(c(1.2, 8.5, 0, 1)) +#' format_range_cens(c(1.2, 8.5, 1, 1)) +#' +#' @family formatting functions +#' @export +format_range_cens <- function(x, ...) { + checkmate::assert_numeric(x, len = 4) + lo <- paste0(round(x[1], 1), if (x[3] != 0) "+") + hi <- paste0(round(x[2], 1), if (x[4] != 0) "+") + paste(lo, "to", hi) +} diff --git a/R/survival_time.R b/R/survival_time.R index ba7b1e6b28..db029ed931 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -81,6 +81,11 @@ s_surv_time <- function(df, range_event <- range_noinf(df[[.var]][df[[is_event]]], na.rm = TRUE) range <- range_noinf(df[[.var]], na.rm = TRUE) + any_censored <- !all(df[[is_event]]) + no_event <- !any(df[[is_event]]) + lower_censored <- any_censored && (no_event || range_censor[1] < range_event[1]) + upper_censored <- any_censored && (no_event || range_censor[2] > range_event[2]) + names(quantiles) <- as.character(100 * quantiles) srv_qt_tab_pre <- unlist(srv_qt_tab_pre) srv_qt_ci <- lapply(quantiles, function(x) { @@ -116,6 +121,10 @@ s_surv_time <- function(df, ), quantiles_upper = formatters::with_label( unname(srv_qt_ci[[2]]), paste0(quantiles[2] * 100, "%-ile (", f_conf_level(conf_level), ")") + ), + range_with_cens_info = formatters::with_label( + c(range, lower_censored, upper_censored), + "Min, max" ) ) } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 937abc8892..d27034db89 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -587,7 +587,8 @@ tern_default_stats <- list( summarize_patients_events_in_cols = c("unique", "all"), surv_time = c( "median", "median_ci", "median_ci_3d", "quantiles", - "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range" + "quantiles_lower", "quantiles_upper", "range_censor", "range_event", "range", + "range_with_cens_info" ), surv_timepoint = c("pt_at_risk", "event_free_rate", "rate_se", "rate_ci", "event_free_rate_3d"), surv_timepoint_diff = c("rate_diff", "rate_diff_ci", "ztest_pval", "rate_diff_ci_3d"), @@ -677,6 +678,7 @@ tern_default_formats <- c( rate_ratio = "xx.xxxx", rate_ratio_ci = "(xx.xxxx, xx.xxxx)", rate_se = "xx.xx", + range_with_cens_info = format_range_cens, riskdiff = "xx.x (xx.x - xx.x)", sd = "xx.x", se = "xx.x", @@ -730,6 +732,7 @@ tern_default_labels <- c( range = "Min - Max", range_censor = "Range (censored)", range_event = "Range (event)", + range_with_cens_info = "Min, max", rate = "Adjusted Rate", rate_ratio = "Adjusted Rate Ratio", sd = "SD", diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index e2d3635889..7a945647d0 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -196,3 +196,69 @@ testthat::test_that("a_surv_time works when `is_event` only has FALSE observatio ) ) }) + +testthat::test_that("s_surv_time includes range_with_cens_info with no censoring at boundaries (0, 0)", { + # All observations are events — no censoring at either boundary + anl <- tibble::tribble( + ~AVAL, ~is_event, + 2, TRUE, + 5, TRUE, + 8, TRUE + ) + result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") + testthat::expect_named(result, c( + "median", "median_ci", "quantiles", "range_censor", "range_event", + "range", "median_ci_3d", "quantiles_lower", "quantiles_upper", "range_with_cens_info" + )) + rwci <- result$range_with_cens_info + testthat::expect_equal(rwci[1:2], c(2, 8)) + testthat::expect_equal(as.numeric(rwci[3:4]), c(0, 0)) +}) + +testthat::test_that("s_surv_time range_with_cens_info flags upper censored (0, 1)", { + # Censored observation has the largest value — upper boundary is censored + anl <- tibble::tribble( + ~AVAL, ~is_event, + 2, TRUE, + 5, TRUE, + 10, FALSE # censored at max + ) + result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") + rwci <- result$range_with_cens_info + testthat::expect_equal(as.numeric(rwci[3]), 0) # lower not censored + testthat::expect_equal(as.numeric(rwci[4]), 1) # upper censored +}) + +testthat::test_that("s_surv_time range_with_cens_info flags lower censored (1, 0)", { + # Censored observation has the smallest value — lower boundary is censored + anl <- tibble::tribble( + ~AVAL, ~is_event, + 1, FALSE, # censored at min + 5, TRUE, + 8, TRUE + ) + result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") + rwci <- result$range_with_cens_info + testthat::expect_equal(as.numeric(rwci[3]), 1) # lower censored + testthat::expect_equal(as.numeric(rwci[4]), 0) # upper not censored +}) + +testthat::test_that("s_surv_time range_with_cens_info flags both bounds censored when all censored (1, 1)", { + # All observations are censored + anl <- tibble::tribble( + ~AVAL, ~is_event, + 2, FALSE, + 5, FALSE, + 8, FALSE + ) + result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") + rwci <- result$range_with_cens_info + testthat::expect_equal(as.numeric(rwci[3:4]), c(1, 1)) +}) + +testthat::test_that("format_range_cens produces correct strings", { + testthat::expect_equal(format_range_cens(c(1.2, 8.5, 0, 0)), "1.2 to 8.5") + testthat::expect_equal(format_range_cens(c(1.2, 8.5, 1, 0)), "1.2+ to 8.5") + testthat::expect_equal(format_range_cens(c(1.2, 8.5, 0, 1)), "1.2 to 8.5+") + testthat::expect_equal(format_range_cens(c(1.2, 8.5, 1, 1)), "1.2+ to 8.5+") +}) From 765f813f2e7624bfb250930b0366589e01b757fd Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 2 Jun 2026 12:51:54 +0000 Subject: [PATCH 16/33] test(snapshot): review and update --- tests/testthat/_snaps/survival_time.md | 32 ++++++++++++++++++-------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index e0325a1c54..2a0b9db48b 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -48,6 +48,11 @@ attr(,"label") [1] "75%-ile (95% CI)" + $range_with_cens_info + [1] 0.07143141 154.08901021 0.00000000 0.00000000 + attr(,"label") + [1] "Min, max" + # s_surv_time works with customized arguments @@ -99,6 +104,11 @@ attr(,"label") [1] "80%-ile (99% CI)" + $range_with_cens_info + [1] 0.07143141 154.08901021 0.00000000 0.00000000 + attr(,"label") + [1] "Min, max" + # a_surv_time works with default arguments @@ -107,16 +117,17 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 median 24.8 0 Median - 2 median_ci (21.10, 31.35) 0 Median 95% CI - 3 median_ci_3d 24.76 (21.10 - 31.35) 0 Median (95% CI) - 4 quantiles 10.8 - 47.6 0 25% and 75%-ile - 5 quantiles_lower 10.81 (6.65 - 13.43) 0 25%-ile (95% CI) - 6 quantiles_upper 47.60 (39.27 - 57.82) 0 75%-ile (95% CI) - 7 range_censor 0.8 to 78.9 0 Range (censored) - 8 range_event 0.1 to 155.5 0 Range (event) - 9 range 0.1 - 155.5 0 Min - Max + row_name formatted_cell indent_mod row_label + 1 median 24.8 0 Median + 2 median_ci (21.10, 31.35) 0 Median 95% CI + 3 median_ci_3d 24.76 (21.10 - 31.35) 0 Median (95% CI) + 4 quantiles 10.8 - 47.6 0 25% and 75%-ile + 5 quantiles_lower 10.81 (6.65 - 13.43) 0 25%-ile (95% CI) + 6 quantiles_upper 47.60 (39.27 - 57.82) 0 75%-ile (95% CI) + 7 range_censor 0.8 to 78.9 0 Range (censored) + 8 range_event 0.1 to 155.5 0 Range (event) + 9 range 0.1 - 155.5 0 Min - Max + 10 range_with_cens_info 0.1 to 155.5 0 Min, max # a_surv_time works with customized arguments @@ -160,6 +171,7 @@ Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 Range 0.3 - 155.5 0.1 - 154.1 0.6 - 80.7 + Min, max 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 # surv_time works with referential footnotes From 2b3b1ce73e4a89634dcd24def15c2e537b1f324f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 2 Jun 2026 14:24:00 +0000 Subject: [PATCH 17/33] Converted `s_surv_time()`to exported functions. --- NAMESPACE | 1 + NEWS.md | 1 + R/formatting_functions.R | 5 ++--- R/survival_time.R | 2 +- _pkgdown.yml | 1 + man/format_range_cens.Rd | 32 +++++++++++++++++++++++++++++ man/survival_time.Rd | 3 +-- tests/testthat/test-survival_time.R | 7 ------- 8 files changed, 39 insertions(+), 13 deletions(-) create mode 100644 man/format_range_cens.Rd diff --git a/NAMESPACE b/NAMESPACE index 07530394a7..6d906e4b34 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -280,6 +280,7 @@ export(s_odds_ratio) export(s_proportion) export(s_proportion_diff) export(s_summary) +export(s_surv_time) export(s_surv_timepoint) export(s_test_proportion_diff) export(sas_na) diff --git a/NEWS.md b/NEWS.md index 509eb254b3..a0f0eed95a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ### Miscellaneous * Updated `roxygen2` to 8.0.0 and added `@exportS3Method` tags for S3 methods in `decorate_grob.R` and `utils_grid.R`. +* Converted `s_surv_time()`to exported functions. ### Enhancements * Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 01642c0fa9..556131cb6d 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -576,7 +576,7 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { #' Format range with censoring indicators #' -#' @description `r lifecycle::badge("stable")` +#' @description `r lifecycle::("experimental")`` #' #' Formats a survival time range where the minimum and/or maximum may be a censored observation. #' A `+` suffix is appended to a bound when the corresponding censoring flag is `TRUE`. @@ -594,8 +594,7 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { #' format_range_cens(c(1.2, 8.5, 0, 1)) #' format_range_cens(c(1.2, 8.5, 1, 1)) #' -#' @family formatting functions -#' @export +#' @keywords internal format_range_cens <- function(x, ...) { checkmate::assert_numeric(x, len = 4) lo <- paste0(round(x[1], 1), if (x[3] != 0) "+") diff --git a/R/survival_time.R b/R/survival_time.R index db029ed931..d7253d8c57 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -52,7 +52,7 @@ NULL #' * `range_event`: Survival time range for observations with events. #' * `range`: Survival time range for all observations. #' -#' @keywords internal +#' @export s_surv_time <- function(df, .var, ..., diff --git a/_pkgdown.yml b/_pkgdown.yml index 8d4ecb1552..fe2e4ce89c 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -64,6 +64,7 @@ reference: - -estimate_coef - -summarize_functions - s_surv_timepoint + - s_surv_time - s_test_proportion_diff - title: Model-Specific Functions diff --git a/man/format_range_cens.Rd b/man/format_range_cens.Rd new file mode 100644 index 0000000000..2ec7f9dfd8 --- /dev/null +++ b/man/format_range_cens.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/formatting_functions.R +\name{format_range_cens} +\alias{format_range_cens} +\title{Format range with censoring indicators} +\usage{ +format_range_cens(x, ...) +} +\arguments{ +\item{x}{(\code{numeric(4)})\\cr vector of the form \code{c(min, max, lower_censored, upper_censored)}, +where \code{lower_censored} and \code{upper_censored} are \code{0}/\code{1} (or \code{FALSE}/\code{TRUE}) flags.} + +\item{...}{not used. Required for \code{rtables} interface.} +} +\value{ +A string in the format \code{"min to max"}, with \code{+} appended to \code{min} and/or \code{max} +when the corresponding censoring flag is non-zero. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} + +Formats a survival time range where the minimum and/or maximum may be a censored observation. +A \code{+} suffix is appended to a bound when the corresponding censoring flag is \code{TRUE}. +} +\examples{ +format_range_cens(c(1.2, 8.5, 0, 0)) +format_range_cens(c(1.2, 8.5, 1, 0)) +format_range_cens(c(1.2, 8.5, 0, 1)) +format_range_cens(c(1.2, 8.5, 1, 1)) + +} +\keyword{internal} diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 13735de25b..072d7bc2fd 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -77,7 +77,7 @@ times, to avoid warnings from \code{rtables}.} \item{.stats}{(\code{character})\cr statistics to select for the table. -Options are: \verb{'median', 'median_ci', 'median_ci_3d', 'quantiles', 'quantiles_lower', 'quantiles_upper', 'range_censor', 'range_event', 'range'}} +Options are: \verb{'median', 'median_ci', 'median_ci_3d', 'quantiles', 'quantiles_lower', 'quantiles_upper', 'range_censor', 'range_event', 'range', 'range_with_cens_info'}} \item{.stat_names}{(\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:as_result_df]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} @@ -174,4 +174,3 @@ a_surv_time( ) } -\keyword{internal} diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index 7a945647d0..ed91c97ee3 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -255,10 +255,3 @@ testthat::test_that("s_surv_time range_with_cens_info flags both bounds censored rwci <- result$range_with_cens_info testthat::expect_equal(as.numeric(rwci[3:4]), c(1, 1)) }) - -testthat::test_that("format_range_cens produces correct strings", { - testthat::expect_equal(format_range_cens(c(1.2, 8.5, 0, 0)), "1.2 to 8.5") - testthat::expect_equal(format_range_cens(c(1.2, 8.5, 1, 0)), "1.2+ to 8.5") - testthat::expect_equal(format_range_cens(c(1.2, 8.5, 0, 1)), "1.2 to 8.5+") - testthat::expect_equal(format_range_cens(c(1.2, 8.5, 1, 1)), "1.2+ to 8.5+") -}) From 5d709af72b4c0ccb8470e7edf32d8692d82af65d Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 2 Jun 2026 14:50:07 +0000 Subject: [PATCH 18/33] fix: r cmd check --- R/formatting_functions.R | 5 ----- man/format_range_cens.Rd | 9 +-------- 2 files changed, 1 insertion(+), 13 deletions(-) diff --git a/R/formatting_functions.R b/R/formatting_functions.R index 556131cb6d..cadd31bd36 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -588,11 +588,6 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { #' @return A string in the format `"min to max"`, with `+` appended to `min` and/or `max` #' when the corresponding censoring flag is non-zero. #' -#' @examples -#' format_range_cens(c(1.2, 8.5, 0, 0)) -#' format_range_cens(c(1.2, 8.5, 1, 0)) -#' format_range_cens(c(1.2, 8.5, 0, 1)) -#' format_range_cens(c(1.2, 8.5, 1, 1)) #' #' @keywords internal format_range_cens <- function(x, ...) { diff --git a/man/format_range_cens.Rd b/man/format_range_cens.Rd index 2ec7f9dfd8..e6940ff8f5 100644 --- a/man/format_range_cens.Rd +++ b/man/format_range_cens.Rd @@ -17,16 +17,9 @@ A string in the format \code{"min to max"}, with \code{+} appended to \code{min} when the corresponding censoring flag is non-zero. } \description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} +`r lifecycle::("experimental")`` Formats a survival time range where the minimum and/or maximum may be a censored observation. A \code{+} suffix is appended to a bound when the corresponding censoring flag is \code{TRUE}. -} -\examples{ -format_range_cens(c(1.2, 8.5, 0, 0)) -format_range_cens(c(1.2, 8.5, 1, 0)) -format_range_cens(c(1.2, 8.5, 0, 1)) -format_range_cens(c(1.2, 8.5, 1, 1)) - } \keyword{internal} From 9ee075c732c56fd14a350bb3e2906de060e54926 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Tue, 2 Jun 2026 14:59:52 +0000 Subject: [PATCH 19/33] fix: typo --- R/formatting_functions.R | 4 ++-- man/format_range_cens.Rd | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/formatting_functions.R b/R/formatting_functions.R index cadd31bd36..e3963f7f6c 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -576,12 +576,12 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { #' Format range with censoring indicators #' -#' @description `r lifecycle::("experimental")`` +#' @description `r lifecycle::badge("experimental")` #' #' Formats a survival time range where the minimum and/or maximum may be a censored observation. #' A `+` suffix is appended to a bound when the corresponding censoring flag is `TRUE`. #' -#' @param x (`numeric(4)`)\\cr vector of the form `c(min, max, lower_censored, upper_censored)`, +#' @param x (`numeric(4)`)\cr vector of the form `c(min, max, lower_censored, upper_censored)`, #' where `lower_censored` and `upper_censored` are `0`/`1` (or `FALSE`/`TRUE`) flags. #' @param ... not used. Required for `rtables` interface. #' diff --git a/man/format_range_cens.Rd b/man/format_range_cens.Rd index e6940ff8f5..321d838408 100644 --- a/man/format_range_cens.Rd +++ b/man/format_range_cens.Rd @@ -7,7 +7,7 @@ format_range_cens(x, ...) } \arguments{ -\item{x}{(\code{numeric(4)})\\cr vector of the form \code{c(min, max, lower_censored, upper_censored)}, +\item{x}{(\code{numeric(4)})\cr vector of the form \code{c(min, max, lower_censored, upper_censored)}, where \code{lower_censored} and \code{upper_censored} are \code{0}/\code{1} (or \code{FALSE}/\code{TRUE}) flags.} \item{...}{not used. Required for \code{rtables} interface.} @@ -17,7 +17,7 @@ A string in the format \code{"min to max"}, with \code{+} appended to \code{min} when the corresponding censoring flag is non-zero. } \description{ -`r lifecycle::("experimental")`` +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} Formats a survival time range where the minimum and/or maximum may be a censored observation. A \code{+} suffix is appended to a bound when the corresponding censoring flag is \code{TRUE}. From 55ab933ab1be43cf959c727a8f29e5125bd67e42 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 3 Jun 2026 14:17:13 +0000 Subject: [PATCH 20/33] update NEWS.md --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index a051af4f71..82604c95ef 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,6 @@ ### Miscellaneous * Updated `roxygen2` to 8.0.0 and added `@exportS3Method` tags for S3 methods in `decorate_grob.R` and `utils_grid.R`. -* Converted `s_ancova()`to exported functions. ### Enhancements * Added `alternative` argument to `s_coxph_pairwise()` to allow one-sided hypothesis testing. @@ -10,6 +9,7 @@ * Added `uncond_exact_diff` method to `estimate_proportion_diff()` for the unconditional exact confidence interval for the difference in proportions by inverting one-sided tail tests over a nuisance parameter. * Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`. * Added `weights_emmeans` parameter on `s_ancova()`. +* Added `s_ancova()`to exported functions. ### Bug Fixes * Fixed bug in `prop_diff_cmh()` which previously failed when strata combinations had 0 observations. From 22cc7f13e1165ac6dec252d770ca69fc3ca0131b Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 3 Jun 2026 14:23:38 +0000 Subject: [PATCH 21/33] update NEWS.md --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 82604c95ef..cdcb4cecd3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,6 @@ * Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`. * Added `uncond_exact_diff` method to `estimate_proportion_diff()` for the unconditional exact confidence interval for the difference in proportions by inverting one-sided tail tests over a nuisance parameter. * Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`. -* Added `weights_emmeans` parameter on `s_ancova()`. * Added `s_ancova()`to exported functions. ### Bug Fixes From 14cbb8a771137926bc786ef7878eede576f3fa81 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 3 Jun 2026 14:45:44 +0000 Subject: [PATCH 22/33] revert: ref_group --- R/summarize_ancova.R | 85 +++++++++++++++++++------------------------- 1 file changed, 37 insertions(+), 48 deletions(-) diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index cd131749fc..24f7feb821 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -110,7 +110,7 @@ h_ancova <- function(.var, #' If working with the reference group, this will be empty. #' * `lsmean_diff_ci`: Confidence level for difference in estimated marginal means in comparison #' to the reference group. -#' * `lsmean_diffci`: Difference in adjusted means with confidence interval as a 3-element vector +#' * `lsmean_diff_with_ci`: Difference in adjusted means with confidence interval as a 3-element vector #' `c(estimate, lower.CL, upper.CL)`. If working with the reference group, this will be `NA`. #' * `pval`: p-value (not adjusted for multiple comparisons). #' @@ -154,8 +154,15 @@ s_ancova <- function(df, # convert characters selected in interaction_y into the numeric order interaction_y <- which(sum_fit_level[[interaction_item]] == interaction_y) sum_fit_level <- sum_fit_level[interaction_y, ] + # if interaction is called, reset the index + ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) + ref_key <- tail(ref_key, n = 1) + ref_key <- (interaction_y - 1) * length(unique(.df_row[[arm]])) + ref_key } else { y <- df[[.var]] + # Get the index of the ref arm when interaction is not called + ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) + ref_key <- tail(ref_key, n = 1) } if (.in_ref_col) { @@ -172,58 +179,40 @@ s_ancova <- function(df, ), lsmean_diff = formatters::with_label(numeric(), "Difference in Adjusted Means"), lsmean_diff_ci = formatters::with_label(numeric(), f_conf_level(conf_level)), - lsmean_diffci = formatters::with_label( + lsmean_diff_with_ci = formatters::with_label( c(NA_real_, NA_real_, NA_real_), - "Difference in Adjusted Means (95% CI)" + paste0("Difference in Adjusted Means (", f_conf_level(conf_level), ")") ), pval = formatters::with_label(numeric(), "p-value") ) } else { - if (!is.null(.ref_group)) { - # Compute ref_key — index of the reference arm in the emmeans grid - if (interaction_y != FALSE) { - ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) - ref_key <- tail(ref_key, n = 1) - ref_key <- (interaction_y - 1) * length(unique(.df_row[[arm]])) + ref_key - } else { - ref_key <- seq(sum_fit[[arm]][unique(.ref_group[[arm]])]) - ref_key <- tail(ref_key, n = 1) - } - # Estimate the differences between the marginal means. - emmeans_contrasts <- emmeans::contrast( - emmeans_fit, - # Compare all arms versus the control arm. - method = "trt.vs.ctrl", - # Take the arm factor from .ref_group as the control arm. - ref = ref_key, - level = conf_level - ) - sum_contrasts <- summary( - emmeans_contrasts, - # Derive confidence intervals, t-tests and p-values. - infer = TRUE, - # Do not adjust the p-values for multiplicity. - adjust = "none" - ) + # Estimate the differences between the marginal means. + emmeans_contrasts <- emmeans::contrast( + emmeans_fit, + # Compare all arms versus the control arm. + method = "trt.vs.ctrl", + # Take the arm factor from .ref_group as the control arm. + ref = ref_key, + level = conf_level + ) + sum_contrasts <- summary( + emmeans_contrasts, + # Derive confidence intervals, t-tests and p-values. + infer = TRUE, + # Do not adjust the p-values for multiplicity. + adjust = "none" + ) - contrast_lvls <- gsub( - "^\\(|\\)$", "", gsub(paste0(" - \\(*", .ref_group[[arm]][1], ".*"), "", sum_contrasts$contrast) - ) - if (!is.null(interaction_item)) { - sum_contrasts_level <- sum_contrasts[grepl(sum_level, contrast_lvls, fixed = TRUE), ] - } else { - sum_contrasts_level <- sum_contrasts[sum_level == contrast_lvls, ] - } - if (interaction_y != FALSE) { - sum_contrasts_level <- sum_contrasts_level[interaction_y, ] - } + contrast_lvls <- gsub( + "^\\(|\\)$", "", gsub(paste0(" - \\(*", .ref_group[[arm]][1], ".*"), "", sum_contrasts$contrast) + ) + if (!is.null(interaction_item)) { + sum_contrasts_level <- sum_contrasts[grepl(sum_level, contrast_lvls, fixed = TRUE), ] } else { - sum_contrasts_level <- list( - estimate = NA_real_, - lower.CL = NA_real_, - upper.CL = NA_real_, - p.value = NA_real_ - ) + sum_contrasts_level <- sum_contrasts[sum_level == contrast_lvls, ] + } + if (interaction_y != FALSE) { + sum_contrasts_level <- sum_contrasts_level[interaction_y, ] } list( @@ -242,9 +231,9 @@ s_ancova <- function(df, c(sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL), f_conf_level(conf_level) ), - lsmean_diffci = formatters::with_label( + lsmean_diff_with_ci = formatters::with_label( c(sum_contrasts_level$estimate, sum_contrasts_level$lower.CL, sum_contrasts_level$upper.CL), - "Difference in Adjusted Means (95% CI)" + paste0("Difference in Adjusted Means (", f_conf_level(conf_level), ")") ), pval = formatters::with_label(sum_contrasts_level$p.value, "p-value") ) From 2d052796a46f867140ceb81b38c3a6c2c5add789 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 3 Jun 2026 14:48:18 +0000 Subject: [PATCH 23/33] refactor: lsmean_diffci to lsmean_diff_with_ci --- R/utils_default_stats_formats_labels.R | 4 ++-- man/summarize_ancova.Rd | 4 ++-- tests/testthat/test-summarize_ancova.R | 12 ++++++------ 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 63f8e15776..25d23b7306 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -581,7 +581,7 @@ tern_default_stats <- list( estimate_proportion = c("n_prop", "prop_ci"), estimate_proportion_diff = c("diff", "diff_ci"), summarize_ancova = c("n", "lsmean", "lsmean_se", "lsmean_ci", - "lsmean_diff", "lsmean_diff_ci", "lsmean_diffci", "pval"), + "lsmean_diff", "lsmean_diff_ci", "lsmean_diff_with_ci", "pval"), summarize_coxreg = c("n", "hr", "ci", "pval", "pval_inter"), summarize_glm_count = c("n", "rate", "rate_ci", "rate_ratio", "rate_ratio_ci", "pval"), summarize_num_patients = c("unique", "nonunique", "unique_count"), @@ -630,7 +630,7 @@ tern_default_formats <- c( lsmean_ci = "xx.xx (xx.xx - xx.xx)", lsmean_diff = "xx.xx", lsmean_diff_ci = "(xx.xx, xx.xx)", - lsmean_diffci = "xx.xx (xx.xx - xx.xx)", + lsmean_diff_with_ci = "xx.xx (xx.xx - xx.xx)", lsmean_se = "xx.xx (xx.xx)", mad = "xx.x", max = "xx.x", diff --git a/man/summarize_ancova.Rd b/man/summarize_ancova.Rd index 5484c8d293..2125c01d8b 100644 --- a/man/summarize_ancova.Rd +++ b/man/summarize_ancova.Rd @@ -91,7 +91,7 @@ times, to avoid warnings from \code{rtables}.} \item{.stats}{(\code{character})\cr statistics to select for the table. -Options are: \verb{'n', 'lsmean', 'lsmean_se', 'lsmean_ci', 'lsmean_diff', 'lsmean_diff_ci', 'lsmean_diffci', 'pval'}} +Options are: \verb{'n', 'lsmean', 'lsmean_se', 'lsmean_ci', 'lsmean_diff', 'lsmean_diff_ci', 'lsmean_diff_with_ci', 'pval'}} \item{.stat_names}{(\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:as_result_df]{rtables::as_result_df()}} with \code{make_ard = TRUE}.} @@ -133,7 +133,7 @@ the statistics from \code{s_ancova()} to the table layout. If working with the reference group, this will be empty. \item \code{lsmean_diff_ci}: Confidence level for difference in estimated marginal means in comparison to the reference group. -\item \code{lsmean_diffci}: Difference in adjusted means with confidence interval as a 3-element vector +\item \code{lsmean_diff_with_ci}: Difference in adjusted means with confidence interval as a 3-element vector \code{c(estimate, lower.CL, upper.CL)}. If working with the reference group, this will be \code{NA}. \item \code{pval}: p-value (not adjusted for multiple comparisons). } diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index 3d14ff85c1..6e76686cb5 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -232,7 +232,7 @@ testthat::test_that("summarize_ancova works with irregular arm levels", { testthat::expect_snapshot(res) }) -testthat::test_that("s_ancova returns lsmean_se, lsmean_ci, lsmean_diffci for non-ref column", { +testthat::test_that("s_ancova returns lsmean_se, lsmean_ci, lsmean_diff_with_ci for non-ref column", { df_col <- iris %>% dplyr::filter(Species == "versicolor") df_ref <- iris %>% dplyr::filter(Species == "setosa") result <- s_ancova( @@ -247,10 +247,10 @@ testthat::test_that("s_ancova returns lsmean_se, lsmean_ci, lsmean_diffci for no testthat::expect_length(result$lsmean_se, 2) testthat::expect_length(result$lsmean_ci, 3) - testthat::expect_length(result$lsmean_diffci, 3) + testthat::expect_length(result$lsmean_diff_with_ci, 3) testthat::expect_equal(as.numeric(result$lsmean_se[[1]]), as.numeric(result$lsmean)) - testthat::expect_equal(as.numeric(result$lsmean_diffci[[1]]), as.numeric(result$lsmean_diff)) - testthat::expect_equal(as.numeric(result$lsmean_diffci[2:3]), as.numeric(result$lsmean_diff_ci)) + testthat::expect_equal(as.numeric(result$lsmean_diff_with_ci[[1]]), as.numeric(result$lsmean_diff)) + testthat::expect_equal(as.numeric(result$lsmean_diff_with_ci[2:3]), as.numeric(result$lsmean_diff_ci)) }) testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { @@ -267,7 +267,7 @@ testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { testthat::expect_length(result$lsmean_se, 2) testthat::expect_length(result$lsmean_ci, 3) - testthat::expect_true(all(is.na(result$lsmean_diffci))) + testthat::expect_true(all(is.na(result$lsmean_diff_with_ci))) testthat::expect_length(result$lsmean_diff, 0) }) @@ -285,7 +285,7 @@ testthat::test_that("s_ancova returns NA diffs when .ref_group is NULL", { testthat::expect_true(is.na(result$lsmean_diff)) testthat::expect_true(all(is.na(result$lsmean_diff_ci))) - testthat::expect_true(all(is.na(result$lsmean_diffci))) + testthat::expect_true(all(is.na(result$lsmean_diff_with_ci))) testthat::expect_true(is.na(result$pval)) }) From 63c681caaa9ed9079d5c449766d369c2a8799350 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Wed, 3 Jun 2026 14:51:03 +0000 Subject: [PATCH 24/33] revert: tests --- tests/testthat/_snaps/summarize_ancova.md | 6 +- tests/testthat/test-summarize_ancova.R | 68 ----------------------- 2 files changed, 3 insertions(+), 71 deletions(-) diff --git a/tests/testthat/_snaps/summarize_ancova.md b/tests/testthat/_snaps/summarize_ancova.md index cb821b2390..5add220e1e 100644 --- a/tests/testthat/_snaps/summarize_ancova.md +++ b/tests/testthat/_snaps/summarize_ancova.md @@ -43,10 +43,10 @@ attr(,"label") [1] "99% CI" - $lsmean_diffci + $lsmean_diff_with_ci [1] -0.4374138 -1.4268150 0.5519873 attr(,"label") - [1] "Difference in Adjusted Means (95% CI)" + [1] "Difference in Adjusted Means (99% CI)" $pval [1] 0.2503574 @@ -87,7 +87,7 @@ attr(,"label") [1] "95% CI" - $lsmean_diffci + $lsmean_diff_with_ci [1] NA NA NA attr(,"label") [1] "Difference in Adjusted Means (95% CI)" diff --git a/tests/testthat/test-summarize_ancova.R b/tests/testthat/test-summarize_ancova.R index 6e76686cb5..e1c49df4cb 100644 --- a/tests/testthat/test-summarize_ancova.R +++ b/tests/testthat/test-summarize_ancova.R @@ -232,27 +232,6 @@ testthat::test_that("summarize_ancova works with irregular arm levels", { testthat::expect_snapshot(res) }) -testthat::test_that("s_ancova returns lsmean_se, lsmean_ci, lsmean_diff_with_ci for non-ref column", { - df_col <- iris %>% dplyr::filter(Species == "versicolor") - df_ref <- iris %>% dplyr::filter(Species == "setosa") - result <- s_ancova( - df = df_col, - .var = "Sepal.Length", - .df_row = iris, - variables = list(arm = "Species", covariates = "Petal.Length"), - .ref_group = df_ref, - .in_ref_col = FALSE, - conf_level = 0.95 - ) - - testthat::expect_length(result$lsmean_se, 2) - testthat::expect_length(result$lsmean_ci, 3) - testthat::expect_length(result$lsmean_diff_with_ci, 3) - testthat::expect_equal(as.numeric(result$lsmean_se[[1]]), as.numeric(result$lsmean)) - testthat::expect_equal(as.numeric(result$lsmean_diff_with_ci[[1]]), as.numeric(result$lsmean_diff)) - testthat::expect_equal(as.numeric(result$lsmean_diff_with_ci[2:3]), as.numeric(result$lsmean_diff_ci)) -}) - testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { df_ref <- iris %>% dplyr::filter(Species == "setosa") result <- s_ancova( @@ -270,50 +249,3 @@ testthat::test_that("s_ancova returns lsmean_se and lsmean_ci for ref column", { testthat::expect_true(all(is.na(result$lsmean_diff_with_ci))) testthat::expect_length(result$lsmean_diff, 0) }) - -testthat::test_that("s_ancova returns NA diffs when .ref_group is NULL", { - df_col <- iris %>% dplyr::filter(Species == "versicolor") - result <- s_ancova( - df = df_col, - .var = "Sepal.Length", - .df_row = iris, - variables = list(arm = "Species", covariates = "Petal.Length"), - .ref_group = NULL, - .in_ref_col = FALSE, - conf_level = 0.95 - ) - - testthat::expect_true(is.na(result$lsmean_diff)) - testthat::expect_true(all(is.na(result$lsmean_diff_ci))) - testthat::expect_true(all(is.na(result$lsmean_diff_with_ci))) - testthat::expect_true(is.na(result$pval)) -}) - -testthat::test_that("s_ancova respects weights_emmeans parameter", { - df_col <- iris %>% dplyr::filter(Species == "versicolor") - df_ref <- iris %>% dplyr::filter(Species == "setosa") - - result_null <- s_ancova( - df = df_col, - .var = "Sepal.Length", - .df_row = iris, - variables = list(arm = "Species", covariates = NULL), - .ref_group = df_ref, - .in_ref_col = FALSE, - conf_level = 0.95, - weights_emmeans = NULL - ) - result_cf <- s_ancova( - df = df_col, - .var = "Sepal.Length", - .df_row = iris, - variables = list(arm = "Species", covariates = NULL), - .ref_group = df_ref, - .in_ref_col = FALSE, - conf_level = 0.95, - weights_emmeans = "counterfactual" - ) - - # With no covariates, proportional and counterfactual weights give the same emmeans - testthat::expect_equal(result_null$lsmean, result_cf$lsmean, tolerance = 1e-6) -}) From db98e204ea8caf2f4d786ec35ad042279f2ea3c5 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 4 Jun 2026 09:31:19 +0000 Subject: [PATCH 25/33] chnage to numeric(0) for consistency. --- R/summarize_ancova.R | 2 +- tests/testthat/_snaps/summarize_ancova.md | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index 24f7feb821..2aee27c1c4 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -180,7 +180,7 @@ s_ancova <- function(df, lsmean_diff = formatters::with_label(numeric(), "Difference in Adjusted Means"), lsmean_diff_ci = formatters::with_label(numeric(), f_conf_level(conf_level)), lsmean_diff_with_ci = formatters::with_label( - c(NA_real_, NA_real_, NA_real_), + numeric(), paste0("Difference in Adjusted Means (", f_conf_level(conf_level), ")") ), pval = formatters::with_label(numeric(), "p-value") diff --git a/tests/testthat/_snaps/summarize_ancova.md b/tests/testthat/_snaps/summarize_ancova.md index 5add220e1e..2f39e02ca7 100644 --- a/tests/testthat/_snaps/summarize_ancova.md +++ b/tests/testthat/_snaps/summarize_ancova.md @@ -88,7 +88,7 @@ [1] "95% CI" $lsmean_diff_with_ci - [1] NA NA NA + numeric(0) attr(,"label") [1] "Difference in Adjusted Means (95% CI)" From 959771b204d64419830983050935b1c007e2bad1 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 4 Jun 2026 09:34:03 +0000 Subject: [PATCH 26/33] docs update --- R/summarize_ancova.R | 2 +- man/summarize_ancova.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/summarize_ancova.R b/R/summarize_ancova.R index 2aee27c1c4..96f4106acb 100644 --- a/R/summarize_ancova.R +++ b/R/summarize_ancova.R @@ -111,7 +111,7 @@ h_ancova <- function(.var, #' * `lsmean_diff_ci`: Confidence level for difference in estimated marginal means in comparison #' to the reference group. #' * `lsmean_diff_with_ci`: Difference in adjusted means with confidence interval as a 3-element vector -#' `c(estimate, lower.CL, upper.CL)`. If working with the reference group, this will be `NA`. +#' `c(estimate, lower.CL, upper.CL)`. #' * `pval`: p-value (not adjusted for multiple comparisons). #' #' @export diff --git a/man/summarize_ancova.Rd b/man/summarize_ancova.Rd index 2125c01d8b..bb044b9281 100644 --- a/man/summarize_ancova.Rd +++ b/man/summarize_ancova.Rd @@ -134,7 +134,7 @@ If working with the reference group, this will be empty. \item \code{lsmean_diff_ci}: Confidence level for difference in estimated marginal means in comparison to the reference group. \item \code{lsmean_diff_with_ci}: Difference in adjusted means with confidence interval as a 3-element vector -\code{c(estimate, lower.CL, upper.CL)}. If working with the reference group, this will be \code{NA}. +\code{c(estimate, lower.CL, upper.CL)}. \item \code{pval}: p-value (not adjusted for multiple comparisons). } } From f1c72b99a888c271f2968ba463583d175fa76d0c Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 4 Jun 2026 13:00:00 +0000 Subject: [PATCH 27/33] lint + if else --- R/formatting_functions.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/formatting_functions.R b/R/formatting_functions.R index e3963f7f6c..ef205eb2de 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -42,7 +42,7 @@ format_fraction <- function(x, ...) { ) } - return(result) + result } #' Format fraction and percentage with fixed single decimal place @@ -77,7 +77,7 @@ format_fraction_fixed_dp <- function(x, ...) { " (", sprintf("%.1f", round(x["num"] / x["denom"] * 100, 1)), "%)" ) } - return(result) + result } #' Format count and fraction @@ -114,7 +114,7 @@ format_count_fraction <- function(x, ...) { paste0(x[1], " (", round(x[2] * 100, 1), "%)") } - return(result) + result } #' Format count and percentage with fixed single decimal place @@ -153,7 +153,7 @@ format_count_fraction_fixed_dp <- function(x, ...) { sprintf("%d (%.1f%%)", x[1], x[2] * 100) } - return(result) + result } #' Format count and fraction with special case for count < 10 @@ -190,7 +190,7 @@ format_count_fraction_lt10 <- function(x, ...) { paste0(x[1], " (", round(x[2] * 100, 1), "%)") } - return(result) + result } #' Format XX as a formatting function @@ -229,17 +229,17 @@ format_xx <- function(str) { rounding <- function(x) { round(x, digits = ifelse(length(y) > 1, nchar(y[2]), 0)) } - return(rounding) + rounding } ) rtable_format <- function(x, output) { values <- Map(y = x, fun = roundings, function(y, fun) fun(y)) regmatches(x = str, m = positions)[[1]] <- values - return(str) + str } - return(rtable_format) + rtable_format } #' Format numeric values by significant figures @@ -534,7 +534,7 @@ format_auto <- function(dt_var, x_stat) { out[is_even] <- str_vals out[!is_even] <- inv_str_fmt - return(paste0(out, collapse = "")) + paste0(out, collapse = "") } } @@ -546,11 +546,11 @@ str_extract <- function(string, pattern = "xx|xx\\.|xx\\.x+", invert = FALSE) { # Helper function count_decimalplaces <- function(dec) { if (is.na(dec)) { - return(0) + 0 } else if (abs(dec - round(dec)) > .Machine$double.eps^0.5) { # For precision nchar(strsplit(format(dec, scientific = FALSE, trim = FALSE), ".", fixed = TRUE)[[1]][[2]]) } else { - return(0) + 0 } } From c1832a3c3ce8d127fe1aaee019c16b79046982ab Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 4 Jun 2026 13:18:28 +0000 Subject: [PATCH 28/33] Min, Max to Min - Max --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 2 +- tests/testthat/_snaps/survival_time.md | 8 ++++---- 3 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index d7253d8c57..09aa97f08b 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -124,7 +124,7 @@ s_surv_time <- function(df, ), range_with_cens_info = formatters::with_label( c(range, lower_censored, upper_censored), - "Min, max" + "Min - Max" ) ) } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index d27034db89..75e5ac59a8 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -732,7 +732,7 @@ tern_default_labels <- c( range = "Min - Max", range_censor = "Range (censored)", range_event = "Range (event)", - range_with_cens_info = "Min, max", + range_with_cens_info = "Min - Max", rate = "Adjusted Rate", rate_ratio = "Adjusted Rate Ratio", sd = "SD", diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index 2a0b9db48b..bec0b8535b 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -51,7 +51,7 @@ $range_with_cens_info [1] 0.07143141 154.08901021 0.00000000 0.00000000 attr(,"label") - [1] "Min, max" + [1] "Min - Max" # s_surv_time works with customized arguments @@ -107,7 +107,7 @@ $range_with_cens_info [1] 0.07143141 154.08901021 0.00000000 0.00000000 attr(,"label") - [1] "Min, max" + [1] "Min - Max" # a_surv_time works with default arguments @@ -127,7 +127,7 @@ 7 range_censor 0.8 to 78.9 0 Range (censored) 8 range_event 0.1 to 155.5 0 Range (event) 9 range 0.1 - 155.5 0 Min - Max - 10 range_with_cens_info 0.1 to 155.5 0 Min, max + 10 range_with_cens_info 0.1 to 155.5 0 Min - Max # a_surv_time works with customized arguments @@ -171,7 +171,7 @@ Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 Range 0.3 - 155.5 0.1 - 154.1 0.6 - 80.7 - Min, max 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + Min - Max 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 # surv_time works with referential footnotes From 580c699874012a7c5f919bb2c98991bcf399de74 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Thu, 4 Jun 2026 14:25:08 +0000 Subject: [PATCH 29/33] add descritpion to roxygen --- R/survival_time.R | 1 + man/survival_time.Rd | 1 + 2 files changed, 2 insertions(+) diff --git a/R/survival_time.R b/R/survival_time.R index 09aa97f08b..3e17488211 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -51,6 +51,7 @@ NULL #' * `range_censor`: Survival time range for censored observations. #' * `range_event`: Survival time range for observations with events. #' * `range`: Survival time range for all observations. +#' * `range_with_cens_info`: Survival time range for all observations, with `+` suffix on censored bounds. #' #' @export s_surv_time <- function(df, diff --git a/man/survival_time.Rd b/man/survival_time.Rd index 072d7bc2fd..20d9c0d671 100644 --- a/man/survival_time.Rd +++ b/man/survival_time.Rd @@ -119,6 +119,7 @@ the statistics from \code{s_surv_time()} to the table layout. \item \code{range_censor}: Survival time range for censored observations. \item \code{range_event}: Survival time range for observations with events. \item \code{range}: Survival time range for all observations. +\item \code{range_with_cens_info}: Survival time range for all observations, with \code{+} suffix on censored bounds. } } From 756082f385f82a74d106b0135168f88e2870e63f Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 5 Jun 2026 08:20:53 +0000 Subject: [PATCH 30/33] Min - Max to Min - Max (with censoring) --- R/survival_time.R | 2 +- R/utils_default_stats_formats_labels.R | 2 +- tests/testthat/_snaps/survival_time.md | 63 +++++++++++++++----------- 3 files changed, 39 insertions(+), 28 deletions(-) diff --git a/R/survival_time.R b/R/survival_time.R index 3e17488211..357cea6592 100644 --- a/R/survival_time.R +++ b/R/survival_time.R @@ -125,7 +125,7 @@ s_surv_time <- function(df, ), range_with_cens_info = formatters::with_label( c(range, lower_censored, upper_censored), - "Min - Max" + "Min - Max (with censoring)" ) ) } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index 75e5ac59a8..b0083e54e0 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -732,7 +732,7 @@ tern_default_labels <- c( range = "Min - Max", range_censor = "Range (censored)", range_event = "Range (event)", - range_with_cens_info = "Min - Max", + range_with_cens_info = "Min - Max (with censoring)", rate = "Adjusted Rate", rate_ratio = "Adjusted Rate Ratio", sd = "SD", diff --git a/tests/testthat/_snaps/survival_time.md b/tests/testthat/_snaps/survival_time.md index bec0b8535b..0416fb55f7 100644 --- a/tests/testthat/_snaps/survival_time.md +++ b/tests/testthat/_snaps/survival_time.md @@ -51,7 +51,7 @@ $range_with_cens_info [1] 0.07143141 154.08901021 0.00000000 0.00000000 attr(,"label") - [1] "Min - Max" + [1] "Min - Max (with censoring)" # s_surv_time works with customized arguments @@ -107,7 +107,7 @@ $range_with_cens_info [1] 0.07143141 154.08901021 0.00000000 0.00000000 attr(,"label") - [1] "Min - Max" + [1] "Min - Max (with censoring)" # a_surv_time works with default arguments @@ -117,17 +117,28 @@ Output RowsVerticalSection (in_rows) object print method: ---------------------------- - row_name formatted_cell indent_mod row_label - 1 median 24.8 0 Median - 2 median_ci (21.10, 31.35) 0 Median 95% CI - 3 median_ci_3d 24.76 (21.10 - 31.35) 0 Median (95% CI) - 4 quantiles 10.8 - 47.6 0 25% and 75%-ile - 5 quantiles_lower 10.81 (6.65 - 13.43) 0 25%-ile (95% CI) - 6 quantiles_upper 47.60 (39.27 - 57.82) 0 75%-ile (95% CI) - 7 range_censor 0.8 to 78.9 0 Range (censored) - 8 range_event 0.1 to 155.5 0 Range (event) - 9 range 0.1 - 155.5 0 Min - Max - 10 range_with_cens_info 0.1 to 155.5 0 Min - Max + row_name formatted_cell indent_mod + 1 median 24.8 0 + 2 median_ci (21.10, 31.35) 0 + 3 median_ci_3d 24.76 (21.10 - 31.35) 0 + 4 quantiles 10.8 - 47.6 0 + 5 quantiles_lower 10.81 (6.65 - 13.43) 0 + 6 quantiles_upper 47.60 (39.27 - 57.82) 0 + 7 range_censor 0.8 to 78.9 0 + 8 range_event 0.1 to 155.5 0 + 9 range 0.1 - 155.5 0 + 10 range_with_cens_info 0.1 to 155.5 0 + row_label + 1 Median + 2 Median 95% CI + 3 Median (95% CI) + 4 25% and 75%-ile + 5 25%-ile (95% CI) + 6 75%-ile (95% CI) + 7 Range (censored) + 8 Range (event) + 9 Min - Max + 10 Min - Max (with censoring) # a_surv_time works with customized arguments @@ -159,19 +170,19 @@ Code res Output - ARM A ARM B ARM C - ——————————————————————————————————————————————————————————————————————————————————————————————————————————————————— - Survival Time (Months) - Median 32.0 23.9 20.8 - 90% CI (25.557055515, 49.309164814) (18.861684287, 32.147869886) (12.954083786, 26.023348062) - Median (90% CI) 32.02 (25.56 - 49.31) 23.91 (18.86 - 32.15) 20.77 (12.95 - 26.02) - 40% and 60%-ile 25.6 - 46.5 18.3 - 29.2 13.0 - 25.7 - 40%-ile (90% CI) 25.56 (20.73 - 33.39) 18.26 (12.77 - 23.91) 12.95 (10.10 - 24.76) - 60%-ile (90% CI) 46.51 (32.02 - 57.82) 29.19 (23.91 - 41.30) 25.75 (20.77 - 37.10) - Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 - Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 - Range 0.3 - 155.5 0.1 - 154.1 0.6 - 80.7 - Min - Max 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + ARM A ARM B ARM C + ————————————————————————————————————————————————————————————————————————————————————————————————————————————————————————— + Survival Time (Months) + Median 32.0 23.9 20.8 + 90% CI (25.557055515, 49.309164814) (18.861684287, 32.147869886) (12.954083786, 26.023348062) + Median (90% CI) 32.02 (25.56 - 49.31) 23.91 (18.86 - 32.15) 20.77 (12.95 - 26.02) + 40% and 60%-ile 25.6 - 46.5 18.3 - 29.2 13.0 - 25.7 + 40%-ile (90% CI) 25.56 (20.73 - 33.39) 18.26 (12.77 - 23.91) 12.95 (10.10 - 24.76) + 60%-ile (90% CI) 46.51 (32.02 - 57.82) 29.19 (23.91 - 41.30) 25.75 (20.77 - 37.10) + Range (censored) 0.8 to 63.5 6.2 to 78.9 3.4 to 52.4 + Range (event) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 + Range 0.3 - 155.5 0.1 - 154.1 0.6 - 80.7 + Min - Max (with censoring) 0.3 to 155.5 0.1 to 154.1 0.6 to 80.7 # surv_time works with referential footnotes From 190da92732a11ac32b997d945360bf989d7f5383 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 5 Jun 2026 08:39:35 +0000 Subject: [PATCH 31/33] feat: add configurable precision in format_range_cens() + add tests for format_range_cens --- NAMESPACE | 1 + R/formatting_functions.R | 30 +++++++++++------- R/utils_default_stats_formats_labels.R | 2 +- man/format_range_cens.Rd | 37 +++++++++++++++++----- tests/testthat/test-formatting_functions.R | 25 +++++++++++++++ 5 files changed, 75 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6d906e4b34..9ff634928b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -137,6 +137,7 @@ export(format_extreme_values_ci) export(format_fraction) export(format_fraction_fixed_dp) export(format_fraction_threshold) +export(format_range_cens) export(format_sigfig) export(format_xx) export(g_bland_altman) diff --git a/R/formatting_functions.R b/R/formatting_functions.R index ef205eb2de..c09d2628a7 100644 --- a/R/formatting_functions.R +++ b/R/formatting_functions.R @@ -581,18 +581,26 @@ apply_auto_formatting <- function(.formats, x_stats, .df_row, .var) { #' Formats a survival time range where the minimum and/or maximum may be a censored observation. #' A `+` suffix is appended to a bound when the corresponding censoring flag is `TRUE`. #' -#' @param x (`numeric(4)`)\cr vector of the form `c(min, max, lower_censored, upper_censored)`, -#' where `lower_censored` and `upper_censored` are `0`/`1` (or `FALSE`/`TRUE`) flags. -#' @param ... not used. Required for `rtables` interface. +#' @param digits (`integer(1)`)\cr number of decimal places to display. Defaults to `1L`. #' -#' @return A string in the format `"min to max"`, with `+` appended to `min` and/or `max` -#' when the corresponding censoring flag is non-zero. +#' @return An `rtables` formatting function that takes a `numeric(4)` vector of the form +#' `c(min, max, lower_censored, upper_censored)`, where `lower_censored` and `upper_censored` +#' are `0`/`1` (or `FALSE`/`TRUE`) flags, and returns a string in the format `"min to max"`, +#' with `+` appended to `min` and/or `max` when the corresponding censoring flag is non-zero. #' +#' @examples +#' fmt <- format_range_cens(1L) +#' fmt(c(1.23, 9.87, 1, 0)) +#' fmt(c(1.23, 9.87, 0, 0)) #' -#' @keywords internal -format_range_cens <- function(x, ...) { - checkmate::assert_numeric(x, len = 4) - lo <- paste0(round(x[1], 1), if (x[3] != 0) "+") - hi <- paste0(round(x[2], 1), if (x[4] != 0) "+") - paste(lo, "to", hi) +#' @family formatting functions +#' @export +format_range_cens <- function(digits = 1L) { + checkmate::assert_integerish(digits) + function(x, ...) { + checkmate::assert_numeric(x, len = 4) + l_result <- paste0(round(x[1], digits), if (x[3] != 0) "+" else "") + h_result <- paste0(round(x[2], digits), if (x[4] != 0) "+" else "") + paste(l_result, "to", h_result) + } } diff --git a/R/utils_default_stats_formats_labels.R b/R/utils_default_stats_formats_labels.R index b0083e54e0..e6bef5b1cc 100644 --- a/R/utils_default_stats_formats_labels.R +++ b/R/utils_default_stats_formats_labels.R @@ -678,7 +678,7 @@ tern_default_formats <- c( rate_ratio = "xx.xxxx", rate_ratio_ci = "(xx.xxxx, xx.xxxx)", rate_se = "xx.xx", - range_with_cens_info = format_range_cens, + range_with_cens_info = list(format_range_cens(1L)), riskdiff = "xx.x (xx.x - xx.x)", sd = "xx.x", se = "xx.x", diff --git a/man/format_range_cens.Rd b/man/format_range_cens.Rd index 321d838408..d5e4c15d3d 100644 --- a/man/format_range_cens.Rd +++ b/man/format_range_cens.Rd @@ -4,17 +4,16 @@ \alias{format_range_cens} \title{Format range with censoring indicators} \usage{ -format_range_cens(x, ...) +format_range_cens(digits = 1L) } \arguments{ -\item{x}{(\code{numeric(4)})\cr vector of the form \code{c(min, max, lower_censored, upper_censored)}, -where \code{lower_censored} and \code{upper_censored} are \code{0}/\code{1} (or \code{FALSE}/\code{TRUE}) flags.} - -\item{...}{not used. Required for \code{rtables} interface.} +\item{digits}{(\code{integer(1)})\cr number of decimal places to display. Defaults to \code{1L}.} } \value{ -A string in the format \code{"min to max"}, with \code{+} appended to \code{min} and/or \code{max} -when the corresponding censoring flag is non-zero. +An \code{rtables} formatting function that takes a \code{numeric(4)} vector of the form +\code{c(min, max, lower_censored, upper_censored)}, where \code{lower_censored} and \code{upper_censored} +are \code{0}/\code{1} (or \code{FALSE}/\code{TRUE}) flags, and returns a string in the format \code{"min to max"}, +with \code{+} appended to \code{min} and/or \code{max} when the corresponding censoring flag is non-zero. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} @@ -22,4 +21,26 @@ when the corresponding censoring flag is non-zero. Formats a survival time range where the minimum and/or maximum may be a censored observation. A \code{+} suffix is appended to a bound when the corresponding censoring flag is \code{TRUE}. } -\keyword{internal} +\examples{ +fmt <- format_range_cens(1L) +fmt(c(1.23, 9.87, 1, 0)) +fmt(c(1.23, 9.87, 0, 0)) + +} +\seealso{ +Other formatting functions: +\code{\link{extreme_format}}, +\code{\link{format_auto}()}, +\code{\link{format_count_fraction}()}, +\code{\link{format_count_fraction_fixed_dp}()}, +\code{\link{format_count_fraction_lt10}()}, +\code{\link{format_extreme_values}()}, +\code{\link{format_extreme_values_ci}()}, +\code{\link{format_fraction}()}, +\code{\link{format_fraction_fixed_dp}()}, +\code{\link{format_fraction_threshold}()}, +\code{\link{format_sigfig}()}, +\code{\link{format_xx}()}, +\code{\link{formatting_functions}} +} +\concept{formatting functions} diff --git a/tests/testthat/test-formatting_functions.R b/tests/testthat/test-formatting_functions.R index 89749ba57a..1b74c1a26e 100644 --- a/tests/testthat/test-formatting_functions.R +++ b/tests/testthat/test-formatting_functions.R @@ -251,3 +251,28 @@ testthat::test_that("auto formatting works with NA values", { testthat::expect_snapshot(result) }) + +testthat::test_that("format_range_cens works with no censoring", { + fmt <- format_range_cens(1L) + testthat::expect_identical(fmt(c(1.2, 9.8, 0, 0)), "1.2 to 9.8") +}) + +testthat::test_that("format_range_cens appends + to lower bound when lower censored", { + fmt <- format_range_cens(1L) + testthat::expect_identical(fmt(c(1.2, 9.8, 1, 0)), "1.2+ to 9.8") +}) + +testthat::test_that("format_range_cens appends + to upper bound when upper censored", { + fmt <- format_range_cens(1L) + testthat::expect_identical(fmt(c(1.2, 9.8, 0, 1)), "1.2 to 9.8+") +}) + +testthat::test_that("format_range_cens appends + to both bounds when both censored", { + fmt <- format_range_cens(1L) + testthat::expect_identical(fmt(c(1.2, 9.8, 1, 1)), "1.2+ to 9.8+") +}) + +testthat::test_that("format_range_cens respects digits argument", { + fmt <- format_range_cens(2L) + testthat::expect_identical(fmt(c(1.234, 9.876, 1, 0)), "1.23+ to 9.88") +}) From 4a08d35a203f56d4cf24772c07bf8ca038d7e5e8 Mon Sep 17 00:00:00 2001 From: munoztd0 Date: Fri, 5 Jun 2026 08:44:43 +0000 Subject: [PATCH 32/33] remove comments --- tests/testthat/test-survival_time.R | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-survival_time.R b/tests/testthat/test-survival_time.R index ed91c97ee3..ebaf7b5717 100644 --- a/tests/testthat/test-survival_time.R +++ b/tests/testthat/test-survival_time.R @@ -198,7 +198,6 @@ testthat::test_that("a_surv_time works when `is_event` only has FALSE observatio }) testthat::test_that("s_surv_time includes range_with_cens_info with no censoring at boundaries (0, 0)", { - # All observations are events — no censoring at either boundary anl <- tibble::tribble( ~AVAL, ~is_event, 2, TRUE, @@ -216,12 +215,11 @@ testthat::test_that("s_surv_time includes range_with_cens_info with no censoring }) testthat::test_that("s_surv_time range_with_cens_info flags upper censored (0, 1)", { - # Censored observation has the largest value — upper boundary is censored anl <- tibble::tribble( ~AVAL, ~is_event, 2, TRUE, 5, TRUE, - 10, FALSE # censored at max + 10, FALSE ) result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") rwci <- result$range_with_cens_info @@ -230,17 +228,16 @@ testthat::test_that("s_surv_time range_with_cens_info flags upper censored (0, 1 }) testthat::test_that("s_surv_time range_with_cens_info flags lower censored (1, 0)", { - # Censored observation has the smallest value — lower boundary is censored anl <- tibble::tribble( ~AVAL, ~is_event, - 1, FALSE, # censored at min + 1, FALSE, 5, TRUE, 8, TRUE ) result <- s_surv_time(anl, .var = "AVAL", is_event = "is_event") rwci <- result$range_with_cens_info - testthat::expect_equal(as.numeric(rwci[3]), 1) # lower censored - testthat::expect_equal(as.numeric(rwci[4]), 0) # upper not censored + testthat::expect_equal(as.numeric(rwci[3]), 1) + testthat::expect_equal(as.numeric(rwci[4]), 0) }) testthat::test_that("s_surv_time range_with_cens_info flags both bounds censored when all censored (1, 1)", { From aefc390b66af506e5e24f99dc0b2715790af35ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20Mu=C3=B1oz=20Tord?= Date: Fri, 5 Jun 2026 16:56:35 +0200 Subject: [PATCH 33/33] Update NEWS.md MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Co-authored-by: Daniel Sabanes Bove Signed-off-by: David Muñoz Tord --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index cdcb4cecd3..3a2ab0fb67 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,7 @@ * Added `lr_stat_df` to the parameters return list of `s_coxph_pairwise()`. * Added `uncond_exact_diff` method to `estimate_proportion_diff()` for the unconditional exact confidence interval for the difference in proportions by inverting one-sided tail tests over a nuisance parameter. * Added `lsmean_se`, `lsmean_ci`, and `lsmean_diffci` statistics to `s_ancova()`. -* Added `s_ancova()`to exported functions. +* Added `s_ancova()` to exported functions. ### Bug Fixes * Fixed bug in `prop_diff_cmh()` which previously failed when strata combinations had 0 observations.