diff --git a/NAMESPACE b/NAMESPACE
index 124285cd..0ff9110d 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,5 +1,6 @@
# Generated by roxygen2: do not edit by hand
+S3method(add_difference_row,tbl_survfit_times)
S3method(add_overall,tbl_baseline_chg)
S3method(add_overall,tbl_hierarchical_rate_and_count)
S3method(add_overall,tbl_hierarchical_rate_by_grade)
@@ -8,6 +9,7 @@ S3method(add_overall,tbl_survfit_quantiles)
S3method(add_overall,tbl_survfit_times)
export("%>%")
export(add_blank_rows)
+export(add_difference_row)
export(add_hierarchical_count_row)
export(add_overall)
export(filter_hierarchical)
@@ -48,6 +50,7 @@ importFrom(dplyr,matches)
importFrom(dplyr,num_range)
importFrom(dplyr,starts_with)
importFrom(dplyr,where)
+importFrom(gtsummary,add_difference_row)
importFrom(gtsummary,add_overall)
importFrom(gtsummary,filter_hierarchical)
importFrom(gtsummary,sort_hierarchical)
diff --git a/R/add_difference_row.R b/R/add_difference_row.R
new file mode 100644
index 00000000..8df64264
--- /dev/null
+++ b/R/add_difference_row.R
@@ -0,0 +1,180 @@
+#' @describeIn tbl_survfit_times
+#'
+#' Adds survival differences between groups as additional rows to tables created by [`tbl_survfit_times()`].
+#'
+#' Difference statistics are calculated using [cardx::ard_survival_survfit_diff()]
+#' for all `tbl_survfit_times(times)` variable values, using `survfit` formula:
+#' ```r
+#' survival::survfit(y ~ by, data = data)
+#' ```
+#' where `y`, `by` and `data` are the inputs of the same names to the `tbl_survfit_times()` object `x`.
+#'
+#' Pairwise differences are calculated relative to the specified `by` variable's specified reference level.
+#'
+#' @inheritParams gtsummary::add_difference.tbl_summary
+#' @param reference (`string`)\cr
+#' Value of the `tbl_survfit_times(by)` variable value that is the reference for
+#' each of the difference calculations. For factors, use the character
+#' level. The reference column will appear as the leftmost column in the table.
+#' @param pvalue_fun (`function`)\cr
+#' Function to round and format the `p.value` statistic. Default is [label_roche_pvalue()].
+#' The function must have a numeric vector input, and return a string that is the
+#' rounded/formatted p-value (e.g. `pvalue_fun = label_style_pvalue(digits = 3)`).
+#'
+#' @export
+#' @order 3
+#'
+#' @examples
+#' # Example 2 - Survival Differences -----------
+#' tbl_survfit_times(
+#' data = cards::ADTTE,
+#' by = "TRTA",
+#' times = c(30, 60),
+#' label = "Day {time}"
+#' ) |>
+#' add_difference_row(reference = "Placebo")
+add_difference_row.tbl_survfit_times <- function(x,
+ reference,
+ statistic = c("{estimate}", "({conf.low}, {conf.high})", "{p.value}"),
+ conf.level = 0.95,
+ pvalue_fun = label_roche_pvalue(),
+ estimate_fun = label_roche_number(digits = 2, scale = 100),
+ ...) {
+ # check inputs ---------------------------------------------------------------
+ set_cli_abort_call()
+ check_dots_empty(call = get_cli_abort_call())
+ check_not_missing(reference)
+ check_string(reference)
+ check_range(conf.level, range = c(0, 1))
+ check_class(statistic, "character")
+ check_class(pvalue_fun, "function")
+ check_class(estimate_fun, "function")
+
+ # check that input `x` has a `by` var with 2+ levels
+ if (is_empty(x$inputs$by)) {
+ cli::cli_abort(
+ "Cannot run {.fun add_difference_row} when {.code tbl_survfit_times()} does not include a {.arg by} argument.",
+ call = get_cli_abort_call()
+ )
+ }
+
+ lst_by_levels <-
+ x$table_styling$header |>
+ dplyr::filter(grepl(pattern = "^stat_\\d*[1-9]\\d*$", x = .data$column)) |>
+ dplyr::select("column", "modify_stat_level") |>
+ deframe() |>
+ lapply(FUN = as.character)
+
+ # check reference level is appropriate
+ if (!as.character(reference) %in% unlist(lst_by_levels)) {
+ cli::cli_abort(
+ "The {.arg reference} argument must be one of {.val {unlist(lst_by_levels)}}.",
+ call = get_cli_abort_call()
+ )
+ }
+
+ # get function inputs --------------------------------------------------------
+ func_inputs <- as.list(environment())
+ by <- x$inputs$by
+ y <- x$inputs$y
+ times <- x$inputs$times
+ data <- x$inputs$data
+ form <- glue("{y} ~ {cardx::bt(by)}") |> stats::as.formula()
+
+ # add reference level to the first position in factor
+ data[[by]] <- fct_relevel(data[[by]], reference, after = 0L)
+ ref_col <- names(lst_by_levels)[lst_by_levels == reference]
+
+ # move reference column to first position in `x`
+ x <- x |>
+ gtsummary::modify_table_body(
+ ~ .x |> dplyr::relocate(all_of(ref_col), .after = "label")
+ )
+
+ # calculate survival difference ----------------------------------------------
+ survfit_diff_ard_fun <- function(data, variable, ...) {
+ cardx::ard_survival_survfit_diff(
+ x = rlang::inject(survival::survfit(!!form, data = data)),
+ times = as.numeric(variable),
+ conf.level = conf.level
+ ) |>
+ dplyr::filter(!.data$stat_name %in% c("method", "reference_level"))
+ }
+
+ # difference to be calculated for each time
+ for (t in times) data[[as.character(t)]] <- NA
+
+ # create difference rows
+ tbl_surv_diff <-
+ data |>
+ # create dummy table to add difference rows to
+ tbl_summary(by = any_of(by), include = as.character(times), missing = "no") |>
+ gtsummary::add_difference_row(
+ reference = reference,
+ statistic = everything() ~ statistic,
+ test = everything() ~ survfit_diff_ard_fun,
+ conf.level = conf.level,
+ pvalue_fun = pvalue_fun,
+ estimate_fun = everything() ~ estimate_fun
+ )
+
+ # build gtsummary table ------------------------------------------------------
+ tbl_surv_diff <-
+ tbl_surv_diff |>
+ # remove time labels
+ gtsummary::modify_table_body(
+ ~ .x |>
+ # remove dummy table label rows
+ dplyr::filter(row_type != "label") |>
+ dplyr::mutate(
+ # match variable names to `x`
+ variable = paste0("time", .data$variable),
+ # add default labels
+ label = dplyr::case_when(
+ .data$label == "Survival Difference" ~ "Difference in Event Free Rates",
+ .data$label == "(CI Lower Bound, CI Upper Bound)" ~ glue("{style_roche_number(conf.level, scale = 100)}% CI"),
+ .data$label == "p-value" ~ "p-value (Z-test)",
+ .default = .data$label
+ )
+ )
+ ) |>
+ # indent rows
+ gtsummary::modify_indent(columns = "label", rows = .data$row_type == "difference_row", indent = 8L) |>
+ gtsummary::modify_indent(columns = "label", rows = .data$label == "Difference in Event Free Rates", indent = 4L)
+
+ # remove ARD for dummy table rows
+ tbl_surv_diff$cards$tbl_summary <- NULL
+
+ # add difference rows into tbl_survfit_times table
+ x <-
+ gtsummary::tbl_stack(
+ tbls = list(x, tbl_surv_diff),
+ quiet = TRUE
+ ) |>
+ # move survival difference rows under each section for each matching survival time
+ gtsummary::modify_table_body(
+ \(x) {
+ x |>
+ dplyr::mutate(
+ variable_f = factor(gsub("-row_difference", "", variable), levels = unique(x$variable)),
+ idx_row = dplyr::row_number()
+ ) |>
+ dplyr::arrange(variable_f, idx_row) |>
+ dplyr::select(-variable_f, -idx_row)
+ }
+ )
+
+ # add info to table ----------------------------------------------------------
+ x$call_list <- list(
+ "tbl_survfit_times" = x$tbls[[1]]$call_list,
+ "add_difference_row" = match.call()
+ )
+ x$cards <- lapply(x$tbls, \(x) x$cards) |> unlist(recursive = FALSE)
+ x$inputs <- list(
+ "tbl_survfit_times" = x$tbls[[1]]$inputs,
+ "add_difference_row" = func_inputs
+ )
+
+ x |>
+ structure(class = c("tbl_survfit_times", "gtsummary"))
+}
diff --git a/R/import-standalone-check_pkg_installed.R b/R/import-standalone-check_pkg_installed.R
index 10575803..c97004e7 100644
--- a/R/import-standalone-check_pkg_installed.R
+++ b/R/import-standalone-check_pkg_installed.R
@@ -6,7 +6,7 @@
# ---
# repo: insightsengineering/standalone
# file: standalone-check_pkg_installed.R
-# last-updated: 2025-02-03
+# last-updated: 2025-10-03
# license: https://unlicense.org
# dependencies: standalone-cli_call_env.R
# imports: [rlang, dplyr, tidyr]
@@ -17,6 +17,9 @@
# ## Changelog
# 2025-02-03
# - `get_pkg_dependencies()` was updated to use base r equivalents for `str_extract()` and `str_remove_all()`.
+#
+# 2025-10-03
+# - `skip_if_pkg_not_installed()` was added.
# nocov start
# styler: off
@@ -38,6 +41,9 @@
#'
#' - `get_min_version_required()` will return, if any, the minimum version of `pkg` required by `ref`.
#'
+#' - `skip_if_pkg_not_installed()` checks whether packages are installed (with the minimum required version)
+#' and skips tests if any are not installed.
+#'
#' @param pkg (`character`)\cr
#' vector of package names to check.
#' @param call (`environment`)\cr
@@ -83,18 +89,13 @@ check_pkg_installed <- function(pkg,
if (!is.character(ref) && !is.null(ref)) cli::cli_abort("{.arg ref} must be a string.")
# get min version data -------------------------------------------------------
- df_pkg_min_version <-
- get_min_version_required(pkg = pkg, ref = ref)
+ df_pkg_min_version <- get_min_version_required(pkg = pkg, ref = ref)
# prompt user to install package ---------------------------------------------
rlang::check_installed(
pkg = df_pkg_min_version$pkg,
- version = df_pkg_min_version$version,
- compare = df_pkg_min_version$compare,
call = call
- ) |>
- # this can be removed after this issue is resolved https://github.com/r-lib/rlang/issues/1694
- suppressWarnings()
+ )
}
#' @inheritParams check_pkg_installed
@@ -108,14 +109,11 @@ is_pkg_installed <- function(pkg,
df_pkg_min_version <-
get_min_version_required(pkg = pkg, ref = ref)
+
# check installation TRUE/FALSE ----------------------------------------------
rlang::is_installed(
- pkg = df_pkg_min_version$pkg,
- version = df_pkg_min_version$version,
- compare = df_pkg_min_version$compare
- ) |>
- # this can be removed after this issue is resolved https://github.com/r-lib/rlang/issues/1694
- suppressWarnings()
+ pkg = df_pkg_min_version$pkg
+ )
}
#' @inheritParams check_pkg_installed
@@ -140,47 +138,20 @@ get_pkg_dependencies <- function(pkg = utils::packageName(), lib.loc = NULL) {
unclass() |>
dplyr::as_tibble() |>
dplyr::select(
- dplyr::any_of(c(
- "Package", "Version", "Imports", "Depends",
- "Suggests", "Enhances", "LinkingTo"
- ))
- ) |>
- dplyr::rename(
- reference_pkg = "Package",
- reference_pkg_version = "Version"
+ dplyr::any_of(c("Imports", "Depends", "Suggests", "Enhances", "LinkingTo"))
) |>
- tidyr::pivot_longer(
- -dplyr::all_of(c("reference_pkg", "reference_pkg_version")),
- values_to = "pkg",
- names_to = "dependency_type",
- ) |>
- tidyr::separate_rows("pkg", sep = ",") |>
+ tidyr::pivot_longer(cols = dplyr::everything(), names_to = NULL, values_to = "pkg") |>
+ tidyr::separate_longer_delim(dplyr::everything(), delim = ",") |>
dplyr::mutate(
pkg = trimws(
x = gsub(x = .data$pkg, pattern = "\\s+", replacement = " "),
which = "both", whitespace = "[ \t\r\n]"
)
- ) |>
- dplyr::filter(!is.na(.data$pkg)) |>
- tidyr::separate(
- .data$pkg,
- into = c("pkg", "version"),
- sep = " ", extra = "merge", fill = "right"
- ) |>
- dplyr::mutate(
- compare = as.character(ifelse(regexpr("[>=<]+", .data$version) > 0,
- regmatches(.data$version, regexpr("[>=<]+", .data$version)),
- NA)),
- version = gsub(pattern = "[\\(\\) >=<]", replacement = "", x = .data$version)
)
}
.empty_pkg_deps_df <- function() {
- dplyr::tibble(
- reference_pkg = character(0L), reference_pkg_version = character(0L),
- dependency_type = character(0L), pkg = character(0L),
- version = character(0L), compare = character(0L)
- )
+ dplyr::tibble(pkg = character(0L))
}
#' @inheritParams check_pkg_installed
@@ -200,17 +171,29 @@ get_min_version_required <- function(pkg, ref = utils::packageName(), lib.loc =
)
}
- # get the package_ref deps and subset on requested pkgs, also supplement df with pkgs
- # that may not be proper deps of the reference package (these pkgs don't have min versions)
- res <-
- get_pkg_dependencies(ref, lib.loc = lib.loc) |>
- dplyr::filter(.data$pkg %in% .env$pkg) |>
- dplyr::full_join(
- dplyr::tibble(pkg = pkg),
- by = "pkg"
- )
+ # get the package_ref deps and subset on requested pkgs
+ res <- get_pkg_dependencies(ref, lib.loc = lib.loc) |>
+ dplyr::filter(grepl(paste0(paste0(.env$pkg, "(\\s|$)"), collapse = "|"), .data$pkg))
+
+ # supplement df with pkgs that may not be proper deps of the reference package (these pkgs don't have min versions)
+ pkg_add <- which(sapply(pkg, \(x) !grepl(x, paste0(res$pkg, collapse = "|")))) |> names()
+ res |>
+ dplyr::full_join(dplyr::tibble(pkg = pkg_add), by = "pkg")
+}
- res
+skip_if_pkg_not_installed <- function(pkg,
+ ref = utils::packageName()) {
+ pkg_deps <- get_min_version_required(pkg, ref = ref)
+ for (p in pkg_deps$pkg) {
+ pkg_installed <- rlang::is_installed(p)
+ if (!pkg_installed) {
+ # skip if any required package is not installed
+ testthat::skip(message = paste(
+ "Required package", shQuote(p, type = "sh"), "is not installed"
+ ))
+ }
+ }
+ invisible()
}
# nocov end
diff --git a/R/reexport.R b/R/reexport.R
index cc3e6ca2..ea11712d 100644
--- a/R/reexport.R
+++ b/R/reexport.R
@@ -16,3 +16,7 @@ gtsummary::filter_hierarchical
#' @export
#' @importFrom gtsummary sort_hierarchical
gtsummary::sort_hierarchical
+
+#' @export
+#' @importFrom gtsummary add_difference_row
+gtsummary::add_difference_row
diff --git a/R/tbl_survfit_times.R b/R/tbl_survfit_times.R
index 920d9cd6..111d37f2 100644
--- a/R/tbl_survfit_times.R
+++ b/R/tbl_survfit_times.R
@@ -13,7 +13,10 @@
#' Character vector of the statistics to report.
#' May use any of the following statistics:
#' `c(n.risk, estimate, std.error, conf.low, conf.high)`,
-#' Default is `c("{n.risk}", "{estimate}%", "{conf.low}%, {conf.high}%")`
+#' Default is `c("{n.risk}", "{estimate}", "({conf.low}, {conf.high})")`
+#'
+#' Statistics available to include when using `add_difference_row()` are:
+#' `"estimate"`, `"std.error"`, `"statistic"`, `"conf.low"`, `"conf.high"`, `"p.value"`.
#' @param estimate_fun (`function`) \cr
#' Function used to style/round the `c(estimate, conf.low, conf.high)` statistics.
#' @param x (`tbl_survfit_times`)\cr
@@ -26,6 +29,7 @@
#'
#' @returns a gtsummary table
#' @name tbl_survfit_times
+#' @order 1
#'
#' @examples
#' # Example 1 ----------------------------------
@@ -40,12 +44,13 @@ NULL
#' @rdname tbl_survfit_times
#' @export
+#' @order 2
tbl_survfit_times <- function(data,
times,
y = "survival::Surv(time = AVAL, event = 1 - CNSR, type = 'right', origin = 0)",
by = NULL,
label = "Time {time}",
- statistic = c("{n.risk}", "{estimate}%", "{conf.low}%, {conf.high}%"),
+ statistic = c("{n.risk}", "{estimate}", "({conf.low}, {conf.high})"),
estimate_fun = label_roche_number(digits = 1, scale = 100),
method.args = list(conf.int = 0.95)) {
# check inputs ---------------------------------------------------------------
@@ -136,8 +141,8 @@ tbl_survfit_times <- function(data,
dplyr::mutate(
label = dplyr::case_when(
.data$label == "Number of Subjects at Risk" ~ "Patients remaining at risk",
- .data$label == "Survival Probability%" ~ "Event Free Rate (%)",
- .data$label == "CI Lower Bound%, CI Upper Bound%" ~ glue("{style_roche_number(conf.level, scale = 100)}% CI"),
+ .data$label == "Survival Probability" ~ "Event Free Rate (%)",
+ .data$label == "(CI Lower Bound, CI Upper Bound)" ~ glue("{style_roche_number(conf.level, scale = 100)}% CI"),
.default = .data$label
)
)
diff --git a/man/reexports.Rd b/man/reexports.Rd
index 64d63500..5c1195f0 100644
--- a/man/reexports.Rd
+++ b/man/reexports.Rd
@@ -7,6 +7,7 @@
\alias{add_overall}
\alias{filter_hierarchical}
\alias{sort_hierarchical}
+\alias{add_difference_row}
\title{Objects exported from other packages}
\keyword{internal}
\description{
@@ -16,6 +17,6 @@ below to see their documentation.
\describe{
\item{dplyr}{\code{\link[dplyr:reexports]{\%>\%}}}
- \item{gtsummary}{\code{\link[gtsummary]{add_overall}}, \code{\link[gtsummary]{filter_hierarchical}}, \code{\link[gtsummary]{sort_hierarchical}}}
+ \item{gtsummary}{\code{\link[gtsummary]{add_difference_row}}, \code{\link[gtsummary]{add_overall}}, \code{\link[gtsummary]{filter_hierarchical}}, \code{\link[gtsummary]{sort_hierarchical}}}
}}
diff --git a/man/tbl_survfit_times.Rd b/man/tbl_survfit_times.Rd
index f46fa41a..a85b5847 100644
--- a/man/tbl_survfit_times.Rd
+++ b/man/tbl_survfit_times.Rd
@@ -1,7 +1,8 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/tbl_survfit_times.R
+% Please edit documentation in R/tbl_survfit_times.R, R/add_difference_row.R
\name{tbl_survfit_times}
\alias{tbl_survfit_times}
+\alias{add_difference_row.tbl_survfit_times}
\alias{add_overall.tbl_survfit_times}
\title{Survival Times}
\usage{
@@ -11,11 +12,21 @@ tbl_survfit_times(
y = "survival::Surv(time = AVAL, event = 1 - CNSR, type = 'right', origin = 0)",
by = NULL,
label = "Time {time}",
- statistic = c("{n.risk}", "{estimate}\%", "{conf.low}\%, {conf.high}\%"),
+ statistic = c("{n.risk}", "{estimate}", "({conf.low}, {conf.high})"),
estimate_fun = label_roche_number(digits = 1, scale = 100),
method.args = list(conf.int = 0.95)
)
+\method{add_difference_row}{tbl_survfit_times}(
+ x,
+ reference,
+ statistic = c("{estimate}", "({conf.low}, {conf.high})", "{p.value}"),
+ conf.level = 0.95,
+ pvalue_fun = label_roche_pvalue(),
+ estimate_fun = label_roche_number(digits = 2, scale = 100),
+ ...
+)
+
\method{add_overall}{tbl_survfit_times}(
x,
last = FALSE,
@@ -47,7 +58,10 @@ the glue syntax injects the time estimate into the label.}
Character vector of the statistics to report.
May use any of the following statistics:
\code{c(n.risk, estimate, std.error, conf.low, conf.high)},
-Default is \code{c("{n.risk}", "{estimate}\%", "{conf.low}\%, {conf.high}\%")}}
+Default is \code{c("{n.risk}", "{estimate}", "({conf.low}, {conf.high})")}
+
+Statistics available to include when using \code{add_difference_row()} are:
+\code{"estimate"}, \code{"std.error"}, \code{"statistic"}, \code{"conf.low"}, \code{"conf.high"}, \code{"p.value"}.}
\item{estimate_fun}{(\code{function}) \cr
Function used to style/round the \code{c(estimate, conf.low, conf.high)} statistics.}
@@ -63,14 +77,27 @@ function.}
\item{x}{(\code{tbl_survfit_times})\cr
A stratified 'tbl_survfit_times' object}
+\item{reference}{(\code{string})\cr
+Value of the \code{tbl_survfit_times(by)} variable value that is the reference for
+each of the difference calculations. For factors, use the character
+level. The reference column will appear as the leftmost column in the table.}
+
+\item{conf.level}{(\code{numeric})\cr
+a scalar in the interval \verb{(0, 1)} indicating the confidence level. Default is 0.95}
+
+\item{pvalue_fun}{(\code{function})\cr
+Function to round and format the \code{p.value} statistic. Default is \code{\link[=label_roche_pvalue]{label_roche_pvalue()}}.
+The function must have a numeric vector input, and return a string that is the
+rounded/formatted p-value (e.g. \code{pvalue_fun = label_style_pvalue(digits = 3)}).}
+
+\item{...}{These dots are for future extensions and must be empty.}
+
\item{last}{(scalar \code{logical})\cr
Logical indicator to display overall column last in table.
Default is \code{FALSE}, which will display overall column first.}
\item{col_label}{(\code{string})\cr
String indicating the column label. Default is \code{"**Overall** \nN = {style_number(N)}"}}
-
-\item{...}{These dots are for future extensions and must be empty.}
}
\value{
a gtsummary table
@@ -84,6 +111,21 @@ When the \code{statistic} argument is modified, the statistic labels will likely
also need to be updated. To change the label, call the \code{modify_table_body()}
function to directly update the underlying \code{x$table_body} data frame.
}
+\section{Methods (by generic)}{
+\itemize{
+\item \code{add_difference_row(tbl_survfit_times)}: Adds survival differences between groups as additional rows to tables created by \code{\link[=tbl_survfit_times]{tbl_survfit_times()}}.
+
+Difference statistics are calculated using \code{\link[cardx:ard_survival_survfit_diff]{cardx::ard_survival_survfit_diff()}}
+for all \code{tbl_survfit_times(times)} variable values, using \code{survfit} formula:
+
+\if{html}{\out{}}\preformatted{survival::survfit(y ~ by, data = data)
+}\if{html}{\out{
}}
+
+where \code{y}, \code{by} and \code{data} are the inputs of the same names to the \code{tbl_survfit_times()} object \code{x}.
+
+Pairwise differences are calculated relative to the specified \code{by} variable's specified reference level.
+
+}}
\examples{
# Example 1 ----------------------------------
tbl_survfit_times(
@@ -93,4 +135,12 @@ tbl_survfit_times(
label = "Day {time}"
) |>
add_overall()
+# Example 2 - Survival Differences -----------
+tbl_survfit_times(
+ data = cards::ADTTE,
+ by = "TRTA",
+ times = c(30, 60),
+ label = "Day {time}"
+) |>
+ add_difference_row(reference = "Placebo")
}
diff --git a/tests/testthat/_snaps/add_difference_row.md b/tests/testthat/_snaps/add_difference_row.md
new file mode 100644
index 00000000..56dd9c93
--- /dev/null
+++ b/tests/testthat/_snaps/add_difference_row.md
@@ -0,0 +1,56 @@
+# add_difference_row.tbl_survfit_times() works
+
+ Code
+ as.data.frame(tbl1)
+ Output
+ Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84)
+ 1 Time 60
+ 2 Patients remaining at risk 59 14 20
+ 3 Event Free Rate (%) 76.8 24.3 31.1
+ 4 95% CI (68.2, 86.6) (15.8, 37.3) (21.9, 44.1)
+ 5 Difference in Event Free Rates 52.54 45.77
+ 6 95% CI (38.65, 66.43) (31.57, 59.97)
+ 7 p-value (Z-test) <0.0001 <0.0001
+ 8 Time 120
+ 9 Patients remaining at risk 45 4 8
+ 10 Event Free Rate (%) 64.3 9.2 14.7
+ 11 95% CI (54.5, 76.0) (3.8, 22.1) (8.0, 27.1)
+ 12 Difference in Event Free Rates 55.16 49.68
+ 13 95% CI (41.76, 68.56) (35.70, 63.65)
+ 14 p-value (Z-test) <0.0001 <0.0001
+
+---
+
+ Code
+ as.data.frame(tbl3)
+ Output
+ Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84)
+ 1 Time 60
+ 2 Patients remaining at risk 59 14 20
+ 3 Event Free Rate (%) 76.8 24.3 31.1
+ 4 95% CI (68.2, 86.6) (15.8, 37.3) (21.9, 44.1)
+ 5 Survival Difference (Survival Difference Standard Error) 52.5 (7.1) 45.8 (7.2)
+ 6 z statistic (p = p-value) 741.5 (p = <0.001) 631.8 (p = <0.001)
+ 7 Time 120
+ 8 Patients remaining at risk 45 4 8
+ 9 Event Free Rate (%) 64.3 9.2 14.7
+ 10 95% CI (54.5, 76.0) (3.8, 22.1) (8.0, 27.1)
+ 11 Survival Difference (Survival Difference Standard Error) 55.2 (6.8) 49.7 (7.1)
+ 12 z statistic (p = p-value) 806.8 (p = <0.001) 696.7 (p = <0.001)
+
+# add_difference_row.tbl_survfit_times() error messaging works
+
+ Code
+ add_difference_row(tbl_survfit_times(data = cards::ADTTE, times = c(30, 60)), "Placebo")
+ Condition
+ Error in `add_difference_row()`:
+ ! Cannot run `add_difference_row()` when `tbl_survfit_times()` does not include a `by` argument.
+
+---
+
+ Code
+ add_difference_row(tbl_survfit_times(data = cards::ADTTE, by = TRTA, times = c(30, 60)), "No Treatment")
+ Condition
+ Error in `add_difference_row()`:
+ ! The `reference` argument must be one of "Placebo", "Xanomeline High Dose", and "Xanomeline Low Dose".
+
diff --git a/tests/testthat/_snaps/tbl_survfit_times.md b/tests/testthat/_snaps/tbl_survfit_times.md
index 924e3dc2..2e8cefac 100644
--- a/tests/testthat/_snaps/tbl_survfit_times.md
+++ b/tests/testthat/_snaps/tbl_survfit_times.md
@@ -6,12 +6,12 @@
Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84)
1 Time 30
2 Patients remaining at risk 69 38 42
- 3 Event Free Rate (%) 84.4% 53.0% 53.4%
- 4 95% CI 77.0%, 92.6% 42.8%, 65.7% 43.4%, 65.6%
+ 3 Event Free Rate (%) 84.4 53.0 53.4
+ 4 95% CI (77.0, 92.6) (42.8, 65.7) (43.4, 65.6)
5 Time 60
6 Patients remaining at risk 59 14 20
- 7 Event Free Rate (%) 76.8% 24.3% 31.1%
- 8 95% CI 68.2%, 86.6% 15.8%, 37.3% 21.9%, 44.1%
+ 7 Event Free Rate (%) 76.8 24.3 31.1
+ 8 95% CI (68.2, 86.6) (15.8, 37.3) (21.9, 44.1)
---
@@ -21,12 +21,12 @@
Drug A \n(N = 98) Drug B \n(N = 102)
1 Time 12
2 Patients remaining at risk 89 88
- 3 Event Free Rate (%) 90.8% 86.3%
- 4 95% CI 85.3%, 96.7% 79.8%, 93.2%
+ 3 Event Free Rate (%) 90.8 86.3
+ 4 95% CI (85.3, 96.7) (79.8, 93.2)
5 Time 15
6 Patients remaining at risk 83 75
- 7 Event Free Rate (%) 84.7% 73.5%
- 8 95% CI 77.9%, 92.1% 65.4%, 82.6%
+ 7 Event Free Rate (%) 84.7 73.5
+ 8 95% CI (77.9, 92.1) (65.4, 82.6)
---
@@ -36,12 +36,12 @@
Overall \n(N = 254)
1 Time 30
2 Patients remaining at risk 149
- 3 Event Free Rate (%) 64.1%
- 4 90% CI 59.1%, 69.4%
+ 3 Event Free Rate (%) 64.1
+ 4 90% CI (59.1, 69.4)
5 Time 60
6 Patients remaining at risk 93
- 7 Event Free Rate (%) 45.7%
- 8 90% CI 40.5%, 51.5%
+ 7 Event Free Rate (%) 45.7
+ 8 90% CI (40.5, 51.5)
# tbl_survfit_times(by) messaging
@@ -68,6 +68,6 @@
Placebo \n(N = 86) Xanomeline High Dose \n(N = 84) Xanomeline Low Dose \n(N = 84) **All Participants** \nN = 254
1 Day 30
2 Patients remaining at risk 69 38 42 149
- 3 Event Free Rate (%) 84.4% 53.0% 53.4% 64.1%
- 4 95% CI 77.0%, 92.6% 42.8%, 65.7% 43.4%, 65.6% 58.2%, 70.5%
+ 3 Event Free Rate (%) 84.4 53.0 53.4 64.1
+ 4 95% CI (77.0, 92.6) (42.8, 65.7) (43.4, 65.6) (58.2, 70.5)
diff --git a/tests/testthat/test-add_difference_row.R b/tests/testthat/test-add_difference_row.R
new file mode 100644
index 00000000..8b28e4b4
--- /dev/null
+++ b/tests/testthat/test-add_difference_row.R
@@ -0,0 +1,73 @@
+skip_if_pkg_not_installed(c("survival", "withr"))
+
+tbl <-
+ tbl_survfit_times(
+ data = cards::ADTTE,
+ by = TRTA,
+ times = c(60, 120)
+ )
+
+test_that("add_difference_row.tbl_survfit_times() works", {
+ withr::local_options(list(width = 200))
+ expect_silent(
+ tbl1 <- tbl |>
+ add_difference_row(reference = "Placebo")
+ )
+ expect_snapshot(as.data.frame(tbl1))
+
+ # works with different reference column
+ expect_silent(
+ tbl2 <- tbl |>
+ add_difference_row(reference = "Xanomeline Low Dose")
+ )
+ expect_equal(
+ as.data.frame(tbl2) |> names(),
+ c("", "Xanomeline Low Dose \n(N = 84)", "Placebo \n(N = 86)", "Xanomeline High Dose \n(N = 84)")
+ )
+
+ # works with custom statistics/formats
+ expect_silent(
+ tbl3 <- tbl |>
+ add_difference_row(
+ reference = "Placebo",
+ statistic = c("{estimate} ({std.error})", "{statistic} (p = {p.value})"),
+ pvalue_fun = label_style_pvalue(digits = 3),
+ estimate_fun = label_roche_number(digits = 1, scale = 100)
+ )
+ )
+ expect_snapshot(as.data.frame(tbl3))
+
+ # no error if overall column is present
+ expect_silent(
+ tbl4 <- tbl |>
+ add_overall(last = TRUE) |>
+ add_difference_row(reference = "Xanomeline High Dose")
+ )
+ expect_equal(
+ as.data.frame(tbl4) |> names(),
+ c("", "Xanomeline High Dose \n(N = 84)", "Placebo \n(N = 86)", "Xanomeline Low Dose \n(N = 84)", "All Participants \nN = 254")
+ )
+})
+
+test_that("add_difference_row.tbl_survfit_times() error messaging works", {
+ withr::local_options(list(width = 200))
+
+ expect_snapshot(
+ error = TRUE,
+ tbl_survfit_times(
+ data = cards::ADTTE,
+ times = c(30, 60)
+ ) |>
+ add_difference_row("Placebo")
+ )
+
+ expect_snapshot(
+ error = TRUE,
+ tbl_survfit_times(
+ data = cards::ADTTE,
+ by = TRTA,
+ times = c(30, 60)
+ ) |>
+ add_difference_row("No Treatment")
+ )
+})
diff --git a/tests/testthat/test-tbl_roche_summary.R b/tests/testthat/test-tbl_roche_summary.R
index 9cce553d..b2621d4f 100644
--- a/tests/testthat/test-tbl_roche_summary.R
+++ b/tests/testthat/test-tbl_roche_summary.R
@@ -1,4 +1,4 @@
-skip_if_not(is_pkg_installed("withr"))
+skip_if_pkg_not_installed("withr")
test_that("tbl_roche_summary() works", {
expect_silent(
diff --git a/tests/testthat/test-tbl_survfit_quantiles.R b/tests/testthat/test-tbl_survfit_quantiles.R
index 51fee101..65c42d82 100644
--- a/tests/testthat/test-tbl_survfit_quantiles.R
+++ b/tests/testthat/test-tbl_survfit_quantiles.R
@@ -1,4 +1,4 @@
-skip_if_not(is_pkg_installed(c("survival", "withr")))
+skip_if_pkg_not_installed(c("survival", "withr"))
test_that("tbl_survfit_quantiles() works", {
withr::local_options(list(width = 120))
diff --git a/tests/testthat/test-tbl_survfit_times.R b/tests/testthat/test-tbl_survfit_times.R
index 39509a70..1fae42dd 100644
--- a/tests/testthat/test-tbl_survfit_times.R
+++ b/tests/testthat/test-tbl_survfit_times.R
@@ -1,4 +1,4 @@
-skip_if_not(is_pkg_installed(c("survival", "withr")))
+skip_if_pkg_not_installed(c("survival", "withr"))
test_that("tbl_survfit_times() works", {
withr::local_options(list(width = 120))