From 3957dc9e4dc4c4b01e56400bfa02338f576f8f11 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 15 Feb 2024 15:45:36 -0500 Subject: [PATCH 01/34] Update DESCRIPTION --- DESCRIPTION | 2 ++ 1 file changed, 2 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index 0bb53e1fb..a9d950d01 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,6 +3,7 @@ Title: Extra Analysis Results Data Utilities Version: 0.0.0.9027 Authors@R: c( person("Daniel", "Sjoberg", , "sjobergd@gene.com", role = c("aut", "cre")), + person("Emily", "de la Rua", , "emily.de_la_rua@contractors.roche.com", role = c("aut")), person("F. Hoffmann-La Roche AG", role = c("cph", "fnd")) ) Description: R Package to Supplement ARD Functions Found in {cards}. @@ -20,6 +21,7 @@ Imports: Suggests: broom (>= 1.0.5), spelling, + survival (>= 3.2-11), testthat (>= 3.2.0) Remotes: insightsengineering/cards From 1889d226379ebe867463f8ee41a450ea2e5e6307 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 15 Feb 2024 16:47:35 -0500 Subject: [PATCH 02/34] Init --- NAMESPACE | 1 + R/ard_survest.R | 167 ++++++++++++++++++++++++++++++ man/ard_survest.Rd | 56 ++++++++++ man/cardx-package.Rd | 5 + man/dot-format_survest_results.Rd | 41 ++++++++ 5 files changed, 270 insertions(+) create mode 100644 R/ard_survest.R create mode 100644 man/ard_survest.Rd create mode 100644 man/dot-format_survest_results.Rd diff --git a/NAMESPACE b/NAMESPACE index 6ac965856..ccba11c35 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,6 +5,7 @@ export(all_of) export(any_of) export(ard_paired_ttest) export(ard_paired_wilcoxtest) +export(ard_survest) export(ard_ttest) export(ard_wilcoxtest) export(contains) diff --git a/R/ard_survest.R b/R/ard_survest.R new file mode 100644 index 000000000..6cec9a408 --- /dev/null +++ b/R/ard_survest.R @@ -0,0 +1,167 @@ +#' ARD Survival Estimates +#' +#' @description +#' Analysis results data for survival quantiles and x-year survival estimates, extracted +#' from a [survival::survfit()] model. +#' +#' @param x ([survival::survfit()])\cr +#' a [survival::survfit()] object. See below for details. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name to compare by +#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name to be compared +#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name of the subject or participant ID +#' @param ... arguments passed to `t.test(...)` +#' +#' @return ARD data frame +#' @name ard_survest +#' +#' @details +#' For the `ard_survest()` function, the data is expected to be one row per subject. +#' The data is passed as `t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. +#' +#' For the `ard_paired_ttest()` function, the data is expected to be one row +#' per subject per by level. Before the t-test is calculated, the data are +#' reshaped to a wide format to be one row per subject. +#' The data are then passed as +#' `t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. +#' +#' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) +#' library(survival) +#' +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' ard_survest() +NULL + +#' @rdname ard_survest +#' @export +ard_survest <- function(x, by = NULL, times = NULL, probs = NULL, conf.level = 0.95, reverse = FALSE, ...) { + # check installed packages --------------------------------------------------- + browser() + cards::check_pkg_installed("survival", reference_pkg = "cardx") + + # input checks --------------------------------------------------------------- + if (purrr::every(x, ~ !inherits(.x, "survfit"))) { + stop("Argument `x=` must be class 'survfit' created from the `survival::survfit()` function.", + call. = FALSE + ) + } + if (c(is.null(times), is.null(probs)) %>% sum() != 1) { + stop("One and only one of `times=` and `probs=` must be specified.", call. = FALSE) + } + if (reverse == TRUE && !is.null(probs)) { + rlang::inform("`reverse=TRUE` argument ignored for survival quantile estimation.") + } + + # check/process inputs ------------------------------------------------------- + check_not_missing(x) + # check_not_missing(by) + # check_class_data_frame(x = data) + # data <- dplyr::ungroup(data) + # cards::process_selectors(data, by = {{ by }}, variable = {{ variable }}) + # check_scalar(by) + + tidy <- broom::tidy(x) + + # adding time 0 to data frame + tidy <- + tidy %>% + # making by a fct to preserve ordering + mutate_at(vars(!!!by), ~ factor(., levels = unique(.))) %>% + # if CI is missing, and SE is 0, making the CIs the estimate + mutate_at( + vars("conf.high", "conf.low"), + ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) + ) %>% + select(any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% + bind_rows( + group_by(., !!!syms(by)) %>% + slice(1) %>% + mutate( + time = 0, + estimate = ifelse(multi_state, 0, 1), + conf.low = ifelse(multi_state, 0, 1), + conf.high = ifelse(multi_state, 0, 1) + ) + ) %>% + ungroup() + + # build ARD ------------------------------------------------------------------ + .format_survest_results( + by = by, + variable = variable, + lst_tidy = + cards::eval_capture_conditions( + stats::t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...) |> + broom::tidy() + ), + paired = FALSE, + ... + ) +} + +#' Convert t-test to ARD +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams stats::t.test +#' @param by (`string`)\cr by column name +#' @param variable (`string`)\cr variable column name +#' @param ... passed to `t.test(...)` +#' +#' @return ARD data frame +#' @keywords internal +#' @examples +#' cardx:::.format_survest_results( +#' by = "ARM", +#' variable = "AGE", +#' paired = FALSE, +#' lst_tidy = +#' cards::eval_capture_conditions( +#' stats::t.test(ADSL[["AGE"]] ~ ADSL[["ARM"]], paired = FALSE) |> +#' broom::tidy() +#' ) +#' ) +.format_survest_results <- function(by, variable, lst_tidy, paired, ...) { + # build ARD ------------------------------------------------------------------ + ret <- + cards::tidy_as_ard( + lst_tidy = lst_tidy, + tidy_result_names = c( + "estimate", "estimate1", "estimate2", "statistic", + "p.value", "parameter", "conf.low", "conf.high", + "method", "alternative" + ), + fun_args_to_record = c("mu", "paired", "var.equal", "conf.level"), + formals = formals(asNamespace("stats")[["t.test.default"]]), + passed_args = c(list(paired = paired), dots_list(...)), + lst_ard_columns = list(group1 = by, variable = variable, context = "survest") + ) + + # add the stat label --------------------------------------------------------- + ret |> + dplyr::left_join( + .df_survest_stat_labels(), + by = "stat_name" + ) |> + dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |> + cards::tidy_ard_column_order() +} + +.df_survest_stat_labels <- function() { + dplyr::tribble( + ~stat_name, ~stat_label, + "estimate1", "Group 1 Mean", + "estimate2", "Group 2 Mean", + "estimate", "Mean Difference", + "p.value", "p-value", + "statistic", "t Statistic", + "parameter", "Degrees of Freedom", + "conf.low", "CI Lower Bound", + "conf.high", "CI Upper Bound", + "mu", "H0 Mean", + "paired", "Paired t-test", + "var.equal", "Equal Variances", + "conf.level", "CI Confidence Level", + ) +} diff --git a/man/ard_survest.Rd b/man/ard_survest.Rd new file mode 100644 index 000000000..9a0106fbb --- /dev/null +++ b/man/ard_survest.Rd @@ -0,0 +1,56 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survest.R +\name{ard_survest} +\alias{ard_survest} +\title{ARD Survival Estimates} +\usage{ +ard_survest( + x, + by = NULL, + times = NULL, + probs = NULL, + conf.level = 0.95, + reverse = FALSE, + ... +) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column name to compare by} + +\item{...}{arguments passed to \code{t.test(...)}} + +\item{variable}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column name to be compared} + +\item{id}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr +column name of the subject or participant ID} +} +\value{ +ARD data frame +} +\description{ +Analysis results data for survival quantiles and x-year survival estimates, extracted +from a \code{\link[survival:survfit]{survival::survfit()}} model. +} +\details{ +For the \code{ard_survest()} function, the data is expected to be one row per subject. +The data is passed as \code{t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)}. + +For the \code{ard_paired_ttest()} function, the data is expected to be one row +per subject per by level. Before the t-test is calculated, the data are +reshaped to a wide format to be one row per subject. +The data are then passed as +\verb{t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. +} +\examples{ +\dontshow{if (broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(survival) + +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survest() +\dontshow{\}) # examplesIf} +} diff --git a/man/cardx-package.Rd b/man/cardx-package.Rd index fb3886d59..e6533d2c0 100644 --- a/man/cardx-package.Rd +++ b/man/cardx-package.Rd @@ -21,6 +21,11 @@ Useful links: \author{ \strong{Maintainer}: Daniel Sjoberg \email{sjobergd@gene.com} +Authors: +\itemize{ + \item Emily de la Rua \email{emily.de_la_rua@contractors.roche.com} +} + Other contributors: \itemize{ \item F. Hoffmann-La Roche AG [copyright holder, funder] diff --git a/man/dot-format_survest_results.Rd b/man/dot-format_survest_results.Rd new file mode 100644 index 000000000..63ac8c931 --- /dev/null +++ b/man/dot-format_survest_results.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survest.R +\name{.format_survest_results} +\alias{.format_survest_results} +\title{Convert t-test to ARD} +\usage{ +.format_survest_results(by, variable, lst_tidy, paired, ...) +} +\arguments{ +\item{by}{(\code{string})\cr by column name} + +\item{variable}{(\code{string})\cr variable column name} + +\item{lst_tidy}{(named \code{list})\cr +list of tidied results constructed with \code{eval_capture_conditions()}, +e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}} + +\item{paired}{a logical indicating whether you want a paired + t-test.} + +\item{...}{passed to \code{t.test(...)}} +} +\value{ +ARD data frame +} +\description{ +Convert t-test to ARD +} +\examples{ +cardx:::.format_survest_results( + by = "ARM", + variable = "AGE", + paired = FALSE, + lst_tidy = + cards::eval_capture_conditions( + stats::t.test(ADSL[["AGE"]] ~ ADSL[["ARM"]], paired = FALSE) |> + broom::tidy() + ) +) +} +\keyword{internal} From 3022a91b7fdc21096322d567e037a09fe311c625 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 16 Feb 2024 21:08:45 -0500 Subject: [PATCH 03/34] Finish fun --- NAMESPACE | 2 +- R/ard_surv_est.R | 241 ++++++++++++++++++++++++ R/ard_survest.R | 167 ---------------- R/ard_wilcoxtest.R | 2 + man/ard_proportion_ci.Rd | 2 +- man/{ard_survest.Rd => ard_surv_est.Rd} | 27 ++- man/dot-format_surv_est_results.Rd | 27 +++ man/dot-format_survest_results.Rd | 41 ---- 8 files changed, 283 insertions(+), 226 deletions(-) create mode 100644 R/ard_surv_est.R delete mode 100644 R/ard_survest.R rename man/{ard_survest.Rd => ard_surv_est.Rd} (80%) create mode 100644 man/dot-format_surv_est_results.Rd delete mode 100644 man/dot-format_survest_results.Rd diff --git a/NAMESPACE b/NAMESPACE index 9241399f6..7366d8fe0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,7 +10,7 @@ export(ard_paired_ttest) export(ard_paired_wilcoxtest) export(ard_proportion_ci) export(ard_regression) -export(ard_survest) +export(ard_surv_est) export(ard_ttest) export(ard_wilcoxtest) export(contains) diff --git a/R/ard_surv_est.R b/R/ard_surv_est.R new file mode 100644 index 000000000..cf319cfce --- /dev/null +++ b/R/ard_surv_est.R @@ -0,0 +1,241 @@ +#' ARD Survival Estimates +#' +#' @description +#' Analysis results data for survival quantiles and x-year survival estimates, extracted +#' from a [survival::survfit()] model. +#' +#' @param x ([survival::survfit()])\cr +#' a [survival::survfit()] object. See below for details. +#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name to compare by +#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name to be compared +#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr +#' column name of the subject or participant ID +#' @param ... arguments passed to `t.test(...)` +#' +#' @return ARD data frame +#' @name ard_surv_est +#' +#' @details +#' For the `ard_surv_est()` function, the data is expected to be one row per subject. +#' The data is passed as `t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. +#' +#' For the `ard_paired_ttest()` function, the data is expected to be one row +#' per subject per by level. Before the t-test is calculated, the data are +#' reshaped to a wide format to be one row per subject. +#' The data are then passed as +#' `t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. +#' +#' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) +#' library(survival) +#' +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' ard_surv_est(times = c(60, 180)) +#' +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' ard_surv_est(probs = c(0.25, 0.5, 0.75)) +NULL + +#' @rdname ard_surv_est +#' @export +ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { + # check installed packages --------------------------------------------------- + cards::check_pkg_installed("survival", reference_pkg = "cardx") + + # input checks --------------------------------------------------------------- + if (!all(inherits(x, "survfit"))) { + stop("Argument `x=` must be class 'survfit' created from the `survival::survfit()` function.", + call. = FALSE + ) + } + if (c(is.null(times), is.null(probs)) %>% sum() != 1) { + stop("One and only one of `times=` and `probs=` must be specified.", call. = FALSE) + } + if (reverse == TRUE && !is.null(probs)) { + rlang::inform("`reverse=TRUE` argument ignored for survival quantile estimation.") + } + + # check/process inputs ------------------------------------------------------- + check_not_missing(x) + + # build ARD ------------------------------------------------------------------ + est_type <- ifelse(is.null(probs), "times", "probs") + tidy_stats <- switch( + est_type, + "times" = .format_survfit_time(x, times, reverse), + "probs" = .format_survfit_probs(x, probs) + ) + + .format_surv_est_results( + tidy_stats, + ... + ) +} + +.format_survfit_time <- function(x, times, reverse) { + tidy <- broom::tidy(x) + + strata <- intersect("strata", names(tidy)) %>% + list() %>% + compact() + multi_state <- inherits(x, "survfitms") + if (multi_state == TRUE) { + # selecting state to show + state <- unique(tidy$state) %>% + setdiff("(s0)") %>% + purrr::pluck(1) + + tidy <- dplyr::filter(tidy, .data$state == .env$state) + } + + # adding time 0 to data frame + tidy <- + tidy %>% + # making strata a fct to preserve ordering + mutate_at(vars(strata), ~ factor(., levels = unique(.))) %>% + # if CI is missing, and SE is 0, making the CIs the estimate + mutate_at( + vars("conf.high", "conf.low"), + ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) + ) %>% + select(any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% + bind_rows( + group_by(., strata) %>% + slice(1) %>% + mutate( + time = 0, + estimate = 1, + conf.low = 1, + conf.high = 1 + ) + ) %>% + ungroup() + + # getting requested estimates + df_stat <- + tidy %>% + # getting the latest time (not showing estimates after that time) + group_by(., strata) %>% + mutate(time_max = max(.data$time)) %>% + ungroup() %>% + # adding in timepoints requested by user + full_join( + select(tidy, strata) %>% + distinct() %>% + mutate( + time = list(.env$times), + col_name = list(paste("stat", seq_len(length(.env$times)), sep = "_")) + ) %>% + unnest(cols = c("time", "col_name")), + by = unlist(c(strata, "time")) + ) %>% + # if the user-specifed time is unobserved, filling estimates with previous value + arrange(strata, .data$time) %>% + group_by(strata) %>% + tidyr::fill( + "estimate", "conf.high", "conf.low", "time_max", + .direction = "down" + ) %>% + ungroup() %>% + # keeping obs of user-specified times + filter(!is.na(.data$col_name)) %>% + # if user-specified time is after the latest follow-up time, making it NA + mutate_at( + vars("estimate", "conf.high", "conf.low"), + ~ ifelse(.data$time > .data$time_max, NA_real_, .) + ) %>% + select(-c(time_max, col_name)) + + # converting to reverse probs, if requested + if (reverse == TRUE) { + df_stat <- + df_stat %>% + mutate_at(vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% + dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") + } + + df_stat +} + +.format_survfit_probs <- function(x, probs) { + tidy <- broom::tidy(x) + + strata <- intersect("strata", names(tidy)) %>% + list() %>% + compact() + + # calculating survival quantiles, and adding estimates to pretty tbl + df_stat <- purrr::map2_dfr( + probs, seq_along(probs), + ~ stats::quantile(x, probs = .x) %>% + as.data.frame() %>% + tibble::rownames_to_column() %>% + set_names(c("strata", "estimate", "conf.low", "conf.high")) %>% + mutate( + prob = .x + ) + ) + + df_stat +} + +#' Convert t-test to ARD +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams stats::t.test +#' @param by (`string`)\cr by column name +#' @param variable (`string`)\cr variable column name +#' @param ... passed to `t.test(...)` +#' +#' @return ARD data frame +#' @keywords internal +#' @examples +#' cardx:::.format_surv_est_results( +#' broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +#' ) +.format_surv_est_results <- function(tidy_stats, ...) { + ret <- tidy_stats %>% + mutate(across( + any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) + )) %>% + pivot_longer( + cols = any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), + names_to = "stat_name", + values_to = "statistic" + ) %>% + separate_wider_delim(strata, "=", names = c("variable", "variable_level")) + + # summarize model ------------------------------------------------------------ + ret |> + dplyr::left_join( + .df_survest_stat_labels(), + by = "stat_name" + ) |> + dplyr::mutate( + statistic_fmt_fn = + lapply( + .data$statistic, + function(x) { + switch(is.integer(x), 0L) %||% switch(is.numeric(x), 1L) + } + ), + context = "survival", + # add the stat label --------------------------------------------------------- + stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) + ) |> + cards::tidy_ard_column_order() %>% + structure(., class = c("card", class(.))) +} + +.df_survest_stat_labels <- function() { + dplyr::tribble( + ~stat_name, ~stat_label, + "estimate", "Survival Probability", + "conf.low", "CI Lower Bound", + "conf.high", "CI Upper Bound", + "conf.level", "CI Confidence Level", + "prob", "Quantile", + "times", "Time" + ) +} diff --git a/R/ard_survest.R b/R/ard_survest.R deleted file mode 100644 index 6cec9a408..000000000 --- a/R/ard_survest.R +++ /dev/null @@ -1,167 +0,0 @@ -#' ARD Survival Estimates -#' -#' @description -#' Analysis results data for survival quantiles and x-year survival estimates, extracted -#' from a [survival::survfit()] model. -#' -#' @param x ([survival::survfit()])\cr -#' a [survival::survfit()] object. See below for details. -#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name to compare by -#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name to be compared -#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name of the subject or participant ID -#' @param ... arguments passed to `t.test(...)` -#' -#' @return ARD data frame -#' @name ard_survest -#' -#' @details -#' For the `ard_survest()` function, the data is expected to be one row per subject. -#' The data is passed as `t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. -#' -#' For the `ard_paired_ttest()` function, the data is expected to be one row -#' per subject per by level. Before the t-test is calculated, the data are -#' reshaped to a wide format to be one row per subject. -#' The data are then passed as -#' `t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. -#' -#' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) -#' library(survival) -#' -#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' ard_survest() -NULL - -#' @rdname ard_survest -#' @export -ard_survest <- function(x, by = NULL, times = NULL, probs = NULL, conf.level = 0.95, reverse = FALSE, ...) { - # check installed packages --------------------------------------------------- - browser() - cards::check_pkg_installed("survival", reference_pkg = "cardx") - - # input checks --------------------------------------------------------------- - if (purrr::every(x, ~ !inherits(.x, "survfit"))) { - stop("Argument `x=` must be class 'survfit' created from the `survival::survfit()` function.", - call. = FALSE - ) - } - if (c(is.null(times), is.null(probs)) %>% sum() != 1) { - stop("One and only one of `times=` and `probs=` must be specified.", call. = FALSE) - } - if (reverse == TRUE && !is.null(probs)) { - rlang::inform("`reverse=TRUE` argument ignored for survival quantile estimation.") - } - - # check/process inputs ------------------------------------------------------- - check_not_missing(x) - # check_not_missing(by) - # check_class_data_frame(x = data) - # data <- dplyr::ungroup(data) - # cards::process_selectors(data, by = {{ by }}, variable = {{ variable }}) - # check_scalar(by) - - tidy <- broom::tidy(x) - - # adding time 0 to data frame - tidy <- - tidy %>% - # making by a fct to preserve ordering - mutate_at(vars(!!!by), ~ factor(., levels = unique(.))) %>% - # if CI is missing, and SE is 0, making the CIs the estimate - mutate_at( - vars("conf.high", "conf.low"), - ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) - ) %>% - select(any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% - bind_rows( - group_by(., !!!syms(by)) %>% - slice(1) %>% - mutate( - time = 0, - estimate = ifelse(multi_state, 0, 1), - conf.low = ifelse(multi_state, 0, 1), - conf.high = ifelse(multi_state, 0, 1) - ) - ) %>% - ungroup() - - # build ARD ------------------------------------------------------------------ - .format_survest_results( - by = by, - variable = variable, - lst_tidy = - cards::eval_capture_conditions( - stats::t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...) |> - broom::tidy() - ), - paired = FALSE, - ... - ) -} - -#' Convert t-test to ARD -#' -#' @inheritParams cards::tidy_as_ard -#' @inheritParams stats::t.test -#' @param by (`string`)\cr by column name -#' @param variable (`string`)\cr variable column name -#' @param ... passed to `t.test(...)` -#' -#' @return ARD data frame -#' @keywords internal -#' @examples -#' cardx:::.format_survest_results( -#' by = "ARM", -#' variable = "AGE", -#' paired = FALSE, -#' lst_tidy = -#' cards::eval_capture_conditions( -#' stats::t.test(ADSL[["AGE"]] ~ ADSL[["ARM"]], paired = FALSE) |> -#' broom::tidy() -#' ) -#' ) -.format_survest_results <- function(by, variable, lst_tidy, paired, ...) { - # build ARD ------------------------------------------------------------------ - ret <- - cards::tidy_as_ard( - lst_tidy = lst_tidy, - tidy_result_names = c( - "estimate", "estimate1", "estimate2", "statistic", - "p.value", "parameter", "conf.low", "conf.high", - "method", "alternative" - ), - fun_args_to_record = c("mu", "paired", "var.equal", "conf.level"), - formals = formals(asNamespace("stats")[["t.test.default"]]), - passed_args = c(list(paired = paired), dots_list(...)), - lst_ard_columns = list(group1 = by, variable = variable, context = "survest") - ) - - # add the stat label --------------------------------------------------------- - ret |> - dplyr::left_join( - .df_survest_stat_labels(), - by = "stat_name" - ) |> - dplyr::mutate(stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name)) |> - cards::tidy_ard_column_order() -} - -.df_survest_stat_labels <- function() { - dplyr::tribble( - ~stat_name, ~stat_label, - "estimate1", "Group 1 Mean", - "estimate2", "Group 2 Mean", - "estimate", "Mean Difference", - "p.value", "p-value", - "statistic", "t Statistic", - "parameter", "Degrees of Freedom", - "conf.low", "CI Lower Bound", - "conf.high", "CI Upper Bound", - "mu", "H0 Mean", - "paired", "Paired t-test", - "var.equal", "Equal Variances", - "conf.level", "CI Confidence Level", - ) -} diff --git a/R/ard_wilcoxtest.R b/R/ard_wilcoxtest.R index f440f57c8..83ba58dc5 100644 --- a/R/ard_wilcoxtest.R +++ b/R/ard_wilcoxtest.R @@ -56,6 +56,7 @@ ard_wilcoxtest <- function(data, by, variable, ...) { check_scalar(by) check_scalar(variable) + browser() # build ARD ------------------------------------------------------------------ .format_wilcoxtest_results( by = by, @@ -127,6 +128,7 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) { #' ) #' ) .format_wilcoxtest_results <- function(by, variable, lst_tidy, paired, ...) { + browser() # build ARD ------------------------------------------------------------------ ret <- cards::tidy_as_ard( diff --git a/man/ard_proportion_ci.Rd b/man/ard_proportion_ci.Rd index 0b821060e..c914d64ad 100644 --- a/man/ard_proportion_ci.Rd +++ b/man/ard_proportion_ci.Rd @@ -36,7 +36,7 @@ when \code{method='strat_wilson'}} \item{method}{(\code{string})\cr string indicating the type of confidence interval to calculate. -Must be one of 'waldcc', 'wald', 'clopper-pearson', 'wilson', 'wilsoncc', 'strat_wilson', 'strat_wilsoncc', 'agresti-coull', 'jeffreys'. +Must be one of "waldcc", "wald", "clopper-pearson", "wilson", "wilsoncc", "strat_wilson", "strat_wilsoncc", "agresti-coull", "jeffreys". See \code{?proportion_ci} for details.} } \value{ diff --git a/man/ard_survest.Rd b/man/ard_surv_est.Rd similarity index 80% rename from man/ard_survest.Rd rename to man/ard_surv_est.Rd index 9a0106fbb..f8664eca7 100644 --- a/man/ard_survest.Rd +++ b/man/ard_surv_est.Rd @@ -1,28 +1,20 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_survest.R -\name{ard_survest} -\alias{ard_survest} +% Please edit documentation in R/ard_surv_est.R +\name{ard_surv_est} +\alias{ard_surv_est} \title{ARD Survival Estimates} \usage{ -ard_survest( - x, - by = NULL, - times = NULL, - probs = NULL, - conf.level = 0.95, - reverse = FALSE, - ... -) +ard_surv_est(x, times = NULL, probs = NULL, reverse = FALSE, ...) } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} +\item{...}{arguments passed to \code{t.test(...)}} + \item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr column name to compare by} -\item{...}{arguments passed to \code{t.test(...)}} - \item{variable}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr column name to be compared} @@ -37,7 +29,7 @@ Analysis results data for survival quantiles and x-year survival estimates, extr from a \code{\link[survival:survfit]{survival::survfit()}} model. } \details{ -For the \code{ard_survest()} function, the data is expected to be one row per subject. +For the \code{ard_surv_est()} function, the data is expected to be one row per subject. The data is passed as \code{t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)}. For the \code{ard_paired_ttest()} function, the data is expected to be one row @@ -51,6 +43,9 @@ The data are then passed as library(survival) survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_survest() + ard_surv_est(times = c(60, 180)) + +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_surv_est(probs = c(0.25, 0.5, 0.75)) \dontshow{\}) # examplesIf} } diff --git a/man/dot-format_surv_est_results.Rd b/man/dot-format_surv_est_results.Rd new file mode 100644 index 000000000..4692ca9bf --- /dev/null +++ b/man/dot-format_surv_est_results.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_surv_est.R +\name{.format_surv_est_results} +\alias{.format_surv_est_results} +\title{Convert t-test to ARD} +\usage{ +.format_surv_est_results(tidy_stats, ...) +} +\arguments{ +\item{...}{passed to \code{t.test(...)}} + +\item{by}{(\code{string})\cr by column name} + +\item{variable}{(\code{string})\cr variable column name} +} +\value{ +ARD data frame +} +\description{ +Convert t-test to ARD +} +\examples{ +cardx:::.format_surv_est_results( + broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +) +} +\keyword{internal} diff --git a/man/dot-format_survest_results.Rd b/man/dot-format_survest_results.Rd deleted file mode 100644 index 63ac8c931..000000000 --- a/man/dot-format_survest_results.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_survest.R -\name{.format_survest_results} -\alias{.format_survest_results} -\title{Convert t-test to ARD} -\usage{ -.format_survest_results(by, variable, lst_tidy, paired, ...) -} -\arguments{ -\item{by}{(\code{string})\cr by column name} - -\item{variable}{(\code{string})\cr variable column name} - -\item{lst_tidy}{(named \code{list})\cr -list of tidied results constructed with \code{eval_capture_conditions()}, -e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}} - -\item{paired}{a logical indicating whether you want a paired - t-test.} - -\item{...}{passed to \code{t.test(...)}} -} -\value{ -ARD data frame -} -\description{ -Convert t-test to ARD -} -\examples{ -cardx:::.format_survest_results( - by = "ARM", - variable = "AGE", - paired = FALSE, - lst_tidy = - cards::eval_capture_conditions( - stats::t.test(ADSL[["AGE"]] ~ ADSL[["ARM"]], paired = FALSE) |> - broom::tidy() - ) -) -} -\keyword{internal} From 1889ef6d84f276c8190dcc2ef7ffcd34230d94d6 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 16:01:05 -0500 Subject: [PATCH 04/34] Rename after refactor --- R/ard_surv_est.R | 27 ++++++++++----------------- 1 file changed, 10 insertions(+), 17 deletions(-) diff --git a/R/ard_surv_est.R b/R/ard_surv_est.R index cf319cfce..4ea953b94 100644 --- a/R/ard_surv_est.R +++ b/R/ard_surv_est.R @@ -12,9 +12,8 @@ #' column name to be compared #' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr #' column name of the subject or participant ID -#' @param ... arguments passed to `t.test(...)` #' -#' @return ARD data frame +#' @return an ARD data frame of class 'card' #' @name ard_surv_est #' #' @details @@ -39,7 +38,7 @@ NULL #' @rdname ard_surv_est #' @export -ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { +ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # check installed packages --------------------------------------------------- cards::check_pkg_installed("survival", reference_pkg = "cardx") @@ -67,10 +66,7 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { "probs" = .format_survfit_probs(x, probs) ) - .format_surv_est_results( - tidy_stats, - ... - ) + .format_surv_est_results(tidy_stats) } .format_survfit_time <- function(x, times, reverse) { @@ -180,21 +176,18 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { df_stat } -#' Convert t-test to ARD +#' Convert Tidied Survival Fit to ARD #' #' @inheritParams cards::tidy_as_ard -#' @inheritParams stats::t.test -#' @param by (`string`)\cr by column name -#' @param variable (`string`)\cr variable column name -#' @param ... passed to `t.test(...)` #' -#' @return ARD data frame +#' @return an ARD data frame of class 'card' #' @keywords internal +#' #' @examples #' cardx:::.format_surv_est_results( #' broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) #' ) -.format_surv_est_results <- function(tidy_stats, ...) { +.format_surv_est_results <- function(tidy_stats) { ret <- tidy_stats %>% mutate(across( any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) @@ -202,7 +195,7 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { pivot_longer( cols = any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), names_to = "stat_name", - values_to = "statistic" + values_to = "stat" ) %>% separate_wider_delim(strata, "=", names = c("variable", "variable_level")) @@ -213,9 +206,9 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE, ...) { by = "stat_name" ) |> dplyr::mutate( - statistic_fmt_fn = + fmt_fn = lapply( - .data$statistic, + .data$stat, function(x) { switch(is.integer(x), 0L) %||% switch(is.numeric(x), 1L) } From 3c2c3f6ee796f2768e394e7ca467784f2515ae5b Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 20:17:20 -0500 Subject: [PATCH 05/34] Update documentation --- NAMESPACE | 2 +- R/{ard_surv_est.R => ard_survfit.R} | 158 +++++++++++++++------------- man/ard_surv_est.Rd | 51 --------- man/ard_survfit.Rd | 43 ++++++++ man/dot-format_surv_est_results.Rd | 27 ----- man/dot-format_survfit_results.Rd | 21 ++++ man/dot-process_survfit_probs.Rd | 29 +++++ man/dot-process_survfit_time.Rd | 34 ++++++ 8 files changed, 215 insertions(+), 150 deletions(-) rename R/{ard_surv_est.R => ard_survfit.R} (58%) delete mode 100644 man/ard_surv_est.Rd create mode 100644 man/ard_survfit.Rd delete mode 100644 man/dot-format_surv_est_results.Rd create mode 100644 man/dot-format_survfit_results.Rd create mode 100644 man/dot-process_survfit_probs.Rd create mode 100644 man/dot-process_survfit_time.Rd diff --git a/NAMESPACE b/NAMESPACE index e1efe1b9e..15109a44d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -13,7 +13,7 @@ export(ard_paired_ttest) export(ard_paired_wilcoxtest) export(ard_proportion_ci) export(ard_regression) -export(ard_surv_est) +export(ard_survfit) export(ard_ttest) export(ard_wilcoxtest) export(contains) diff --git a/R/ard_surv_est.R b/R/ard_survfit.R similarity index 58% rename from R/ard_surv_est.R rename to R/ard_survfit.R index 4ea953b94..7d550a139 100644 --- a/R/ard_surv_est.R +++ b/R/ard_survfit.R @@ -6,96 +6,101 @@ #' #' @param x ([survival::survfit()])\cr #' a [survival::survfit()] object. See below for details. -#' @param by ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name to compare by -#' @param variable ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name to be compared -#' @param id ([`tidy-select`][dplyr::dplyr_tidy_select])\cr -#' column name of the subject or participant ID +#' @param times (`numeric`)\cr +#' a vector of times for which to return survival probabilities. +#' @param probs (`numeric`)\cr +#' a vector of probabilities with values in (0,1) specifying the survival quantiles to return. +#' @param reverse (`logical`)\cr +#' Flip the probability reported, i.e. `1 - estimate`. Default is `FALSE`. Only applies when +#' `probs` is specified. #' #' @return an ARD data frame of class 'card' -#' @name ard_surv_est +#' @name ard_survfit #' #' @details -#' For the `ard_surv_est()` function, the data is expected to be one row per subject. -#' The data is passed as `t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)`. -#' -#' For the `ard_paired_ttest()` function, the data is expected to be one row -#' per subject per by level. Before the t-test is calculated, the data are -#' reshaped to a wide format to be one row per subject. -#' The data are then passed as -#' `t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)`. +#' Only one of either the `times` or `probs` parameters can be specified. #' #' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) #' library(survival) #' #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' ard_surv_est(times = c(60, 180)) +#' ard_survfit(times = c(60, 180)) #' #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' ard_surv_est(probs = c(0.25, 0.5, 0.75)) +#' ard_survfit(probs = c(0.25, 0.5, 0.75)) NULL -#' @rdname ard_surv_est +#' @rdname ard_survfit #' @export -ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { +ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # check installed packages --------------------------------------------------- cards::check_pkg_installed("survival", reference_pkg = "cardx") - # input checks --------------------------------------------------------------- + # check/process inputs ------------------------------------------------------- + check_not_missing(x) + check_range(probs, c(0, 1)) + check_binary(reverse) + if (!all(inherits(x, "survfit"))) { - stop("Argument `x=` must be class 'survfit' created from the `survival::survfit()` function.", - call. = FALSE + cli::cli_abort( + "The {.arg x} argument must be class {.cls survfit} created using the {.fun survival::survfit} function." ) } - if (c(is.null(times), is.null(probs)) %>% sum() != 1) { - stop("One and only one of `times=` and `probs=` must be specified.", call. = FALSE) + if (sum(is.null(times), is.null(probs)) != 1) { + cli::cli_abort( + "One and only one of {.arg times} and {.arg probs} must be specified." + ) } - if (reverse == TRUE && !is.null(probs)) { - rlang::inform("`reverse=TRUE` argument ignored for survival quantile estimation.") + if (reverse && !is.null(probs)) { + cli::cli_inform( + "The {.code reverse=TRUE} argument is ignored for survival quantile estimation." + ) } - # check/process inputs ------------------------------------------------------- - check_not_missing(x) - # build ARD ------------------------------------------------------------------ est_type <- ifelse(is.null(probs), "times", "probs") - tidy_stats <- switch( + tidy_survfit <- switch( est_type, - "times" = .format_survfit_time(x, times, reverse), - "probs" = .format_survfit_probs(x, probs) + "times" = .process_survfit_time(x, times, reverse), + "probs" = .process_survfit_probs(x, probs) ) - .format_surv_est_results(tidy_stats) + .format_survfit_results(tidy_survfit) } -.format_survfit_time <- function(x, times, reverse) { +#' Process Survival Fit For Time Estimates +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams ard_survfit +#' +#' @return a tibble +#' +#' @examples +#' cardx:::.format_survfit_time( +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), +#' times = c(60, 180), +#' reverse = FALSE +#' ) +#' +#' @keywords internal +.process_survfit_time <- function(x, times, reverse) { tidy <- broom::tidy(x) strata <- intersect("strata", names(tidy)) %>% list() %>% compact() - multi_state <- inherits(x, "survfitms") - if (multi_state == TRUE) { - # selecting state to show - state <- unique(tidy$state) %>% - setdiff("(s0)") %>% - purrr::pluck(1) - - tidy <- dplyr::filter(tidy, .data$state == .env$state) - } # adding time 0 to data frame - tidy <- - tidy %>% - # making strata a fct to preserve ordering + tidy <- tidy %>% + # make strata a fct to preserve ordering mutate_at(vars(strata), ~ factor(., levels = unique(.))) %>% - # if CI is missing, and SE is 0, making the CIs the estimate + # if CI is missing, and SE is 0, make the CI the estimate mutate_at( vars("conf.high", "conf.low"), ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) ) %>% select(any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% + # add data for time 0 bind_rows( group_by(., strata) %>% slice(1) %>% @@ -108,14 +113,13 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { ) %>% ungroup() - # getting requested estimates - df_stat <- - tidy %>% - # getting the latest time (not showing estimates after that time) + # get requested estimates + df_stat <- tidy %>% + # find max time group_by(., strata) %>% mutate(time_max = max(.data$time)) %>% ungroup() %>% - # adding in timepoints requested by user + # add requested timepoints full_join( select(tidy, strata) %>% distinct() %>% @@ -126,7 +130,7 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { unnest(cols = c("time", "col_name")), by = unlist(c(strata, "time")) ) %>% - # if the user-specifed time is unobserved, filling estimates with previous value + # if user-specifed time is unobserved, fill estimate with previous value arrange(strata, .data$time) %>% group_by(strata) %>% tidyr::fill( @@ -134,17 +138,17 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { .direction = "down" ) %>% ungroup() %>% - # keeping obs of user-specified times + # keep only user-specified times filter(!is.na(.data$col_name)) %>% - # if user-specified time is after the latest follow-up time, making it NA + # if user-specified time is after max time, make estimate NA mutate_at( vars("estimate", "conf.high", "conf.low"), ~ ifelse(.data$time > .data$time_max, NA_real_, .) ) %>% select(-c(time_max, col_name)) - # converting to reverse probs, if requested - if (reverse == TRUE) { + # reverse probs if requested + if (reverse) { df_stat <- df_stat %>% mutate_at(vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% @@ -154,23 +158,36 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { df_stat } -.format_survfit_probs <- function(x, probs) { +#' Process Survival Fit For Quantile Estimates +#' +#' @inheritParams cards::tidy_as_ard +#' @inheritParams ard_survfit +#' +#' @return a tibble +#' +#' @examples +#' cardx:::.format_survfit_probs( +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), +#' probs = c(0.25, 0.5, 0.75) +#' ) +#' +#' @keywords internal +.process_survfit_probs <- function(x, probs) { tidy <- broom::tidy(x) strata <- intersect("strata", names(tidy)) %>% list() %>% compact() - # calculating survival quantiles, and adding estimates to pretty tbl + # calculate survival quantiles and add estimates to df df_stat <- purrr::map2_dfr( - probs, seq_along(probs), + probs, + seq_along(probs), ~ stats::quantile(x, probs = .x) %>% as.data.frame() %>% tibble::rownames_to_column() %>% set_names(c("strata", "estimate", "conf.low", "conf.high")) %>% - mutate( - prob = .x - ) + mutate(prob = .x) ) df_stat @@ -181,14 +198,15 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @inheritParams cards::tidy_as_ard #' #' @return an ARD data frame of class 'card' -#' @keywords internal #' #' @examples -#' cardx:::.format_surv_est_results( +#' cardx:::.format_survfit_results( #' broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) #' ) -.format_surv_est_results <- function(tidy_stats) { - ret <- tidy_stats %>% +#' +#' @keywords internal +.format_survfit_results <- function(tidy_survfit) { + ret <- tidy_survfit %>% mutate(across( any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% @@ -199,10 +217,9 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { ) %>% separate_wider_delim(strata, "=", names = c("variable", "variable_level")) - # summarize model ------------------------------------------------------------ ret |> dplyr::left_join( - .df_survest_stat_labels(), + .df_survfit_stat_labels(), by = "stat_name" ) |> dplyr::mutate( @@ -214,14 +231,13 @@ ard_surv_est <- function(x, times = NULL, probs = NULL, reverse = FALSE) { } ), context = "survival", - # add the stat label --------------------------------------------------------- stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) ) |> cards::tidy_ard_column_order() %>% structure(., class = c("card", class(.))) } -.df_survest_stat_labels <- function() { +.df_survfit_stat_labels <- function() { dplyr::tribble( ~stat_name, ~stat_label, "estimate", "Survival Probability", diff --git a/man/ard_surv_est.Rd b/man/ard_surv_est.Rd deleted file mode 100644 index f8664eca7..000000000 --- a/man/ard_surv_est.Rd +++ /dev/null @@ -1,51 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_surv_est.R -\name{ard_surv_est} -\alias{ard_surv_est} -\title{ARD Survival Estimates} -\usage{ -ard_surv_est(x, times = NULL, probs = NULL, reverse = FALSE, ...) -} -\arguments{ -\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr -a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} - -\item{...}{arguments passed to \code{t.test(...)}} - -\item{by}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -column name to compare by} - -\item{variable}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -column name to be compared} - -\item{id}{(\code{\link[dplyr:dplyr_tidy_select]{tidy-select}})\cr -column name of the subject or participant ID} -} -\value{ -ARD data frame -} -\description{ -Analysis results data for survival quantiles and x-year survival estimates, extracted -from a \code{\link[survival:survfit]{survival::survfit()}} model. -} -\details{ -For the \code{ard_surv_est()} function, the data is expected to be one row per subject. -The data is passed as \code{t.test(data[[variable]] ~ data[[by]], paired = FALSE, ...)}. - -For the \code{ard_paired_ttest()} function, the data is expected to be one row -per subject per by level. Before the t-test is calculated, the data are -reshaped to a wide format to be one row per subject. -The data are then passed as -\verb{t.test(x = data_wide[[]], y = data_wide[[]], paired = TRUE, ...)}. -} -\examples{ -\dontshow{if (broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -library(survival) - -survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_surv_est(times = c(60, 180)) - -survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_surv_est(probs = c(0.25, 0.5, 0.75)) -\dontshow{\}) # examplesIf} -} diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd new file mode 100644 index 000000000..2efab2687 --- /dev/null +++ b/man/ard_survfit.Rd @@ -0,0 +1,43 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survfit.R +\name{ard_survfit} +\alias{ard_survfit} +\title{ARD Survival Estimates} +\usage{ +ard_survfit(x, times = NULL, probs = NULL, reverse = FALSE) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{times}{(\code{numeric})\cr +a vector of times for which to return survival probabilities.} + +\item{probs}{(\code{numeric})\cr +a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} + +\item{reverse}{(\code{logical})\cr +Flip the probability reported, i.e. \code{1 - estimate}. Default is \code{FALSE}. Only applies when +\code{probs} is specified.} +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Analysis results data for survival quantiles and x-year survival estimates, extracted +from a \code{\link[survival:survfit]{survival::survfit()}} model. +} +\details{ +Only one of either the \code{times} or \code{probs} parameters can be specified. +} +\examples{ +\dontshow{if (broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +library(survival) + +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(times = c(60, 180)) + +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(probs = c(0.25, 0.5, 0.75)) +\dontshow{\}) # examplesIf} +} diff --git a/man/dot-format_surv_est_results.Rd b/man/dot-format_surv_est_results.Rd deleted file mode 100644 index 4692ca9bf..000000000 --- a/man/dot-format_surv_est_results.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/ard_surv_est.R -\name{.format_surv_est_results} -\alias{.format_surv_est_results} -\title{Convert t-test to ARD} -\usage{ -.format_surv_est_results(tidy_stats, ...) -} -\arguments{ -\item{...}{passed to \code{t.test(...)}} - -\item{by}{(\code{string})\cr by column name} - -\item{variable}{(\code{string})\cr variable column name} -} -\value{ -ARD data frame -} -\description{ -Convert t-test to ARD -} -\examples{ -cardx:::.format_surv_est_results( - broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) -) -} -\keyword{internal} diff --git a/man/dot-format_survfit_results.Rd b/man/dot-format_survfit_results.Rd new file mode 100644 index 000000000..c4f159693 --- /dev/null +++ b/man/dot-format_survfit_results.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survfit.R +\name{.format_survfit_results} +\alias{.format_survfit_results} +\title{Convert Tidied Survival Fit to ARD} +\usage{ +.format_survfit_results(tidy_survfit) +} +\value{ +an ARD data frame of class 'card' +} +\description{ +Convert Tidied Survival Fit to ARD +} +\examples{ +cardx:::.format_survfit_results( + broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +) + +} +\keyword{internal} diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd new file mode 100644 index 000000000..32c7825d8 --- /dev/null +++ b/man/dot-process_survfit_probs.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survfit.R +\name{.process_survfit_probs} +\alias{.process_survfit_probs} +\title{Process Survival Fit For Quantile Estimates} +\usage{ +.process_survfit_probs(x, probs) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{probs}{(\code{numeric})\cr +a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} +} +\value{ +a tibble +} +\description{ +Process Survival Fit For Quantile Estimates +} +\examples{ +cardx:::.format_survfit_probs( + survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + probs = c(0.25, 0.5, 0.75) +) + +} +\keyword{internal} diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd new file mode 100644 index 000000000..b608091f4 --- /dev/null +++ b/man/dot-process_survfit_time.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ard_survfit.R +\name{.process_survfit_time} +\alias{.process_survfit_time} +\title{Process Survival Fit For Time Estimates} +\usage{ +.process_survfit_time(x, times, reverse) +} +\arguments{ +\item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr +a \code{\link[survival:survfit]{survival::survfit()}} object. See below for details.} + +\item{times}{(\code{numeric})\cr +a vector of times for which to return survival probabilities.} + +\item{reverse}{(\code{logical})\cr +Flip the probability reported, i.e. \code{1 - estimate}. Default is \code{FALSE}. Only applies when +\code{probs} is specified.} +} +\value{ +a tibble +} +\description{ +Process Survival Fit For Time Estimates +} +\examples{ +cardx:::.format_survfit_time( + survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + times = c(60, 180), + reverse = FALSE +) + +} +\keyword{internal} From 7fd9326e8ebb4dbe77efef76b4c51203c50f5c14 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 21:09:21 -0500 Subject: [PATCH 06/34] Add tests, clean up --- R/ard_survfit.R | 135 ++++++++++++--------------- man/ard_survfit.Rd | 6 +- man/dot-process_survfit_probs.Rd | 6 +- man/dot-process_survfit_time.Rd | 7 +- tests/testthat/_snaps/ard_survfit.md | 74 +++++++++++++++ tests/testthat/test-ard_survfit.R | 21 +++++ 6 files changed, 162 insertions(+), 87 deletions(-) create mode 100644 tests/testthat/_snaps/ard_survfit.md create mode 100644 tests/testthat/test-ard_survfit.R diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 7d550a139..0f97cfad7 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -18,7 +18,9 @@ #' @name ard_survfit #' #' @details -#' Only one of either the `times` or `probs` parameters can be specified. +#' * Only one of either the `times` or `probs` parameters can be specified. +#' * Times should be provided using the same scale as the time variable used to fit the provided +#' survival fit model. #' #' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) #' library(survival) @@ -38,23 +40,18 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # check/process inputs ------------------------------------------------------- check_not_missing(x) - check_range(probs, c(0, 1)) check_binary(reverse) - + if (!is.null(probs)) check_range(probs, c(0, 1)) if (!all(inherits(x, "survfit"))) { cli::cli_abort( "The {.arg x} argument must be class {.cls survfit} created using the {.fun survival::survfit} function." ) } if (sum(is.null(times), is.null(probs)) != 1) { - cli::cli_abort( - "One and only one of {.arg times} and {.arg probs} must be specified." - ) + cli::cli_abort("One and only one of {.arg times} and {.arg probs} must be specified.") } if (reverse && !is.null(probs)) { - cli::cli_inform( - "The {.code reverse=TRUE} argument is ignored for survival quantile estimation." - ) + cli::cli_inform("The {.code reverse=TRUE} argument is ignored for survival quantile estimation.") } # build ARD ------------------------------------------------------------------ @@ -76,82 +73,75 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @return a tibble #' #' @examples -#' cardx:::.format_survfit_time( -#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), -#' times = c(60, 180), -#' reverse = FALSE -#' ) +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) #' #' @keywords internal .process_survfit_time <- function(x, times, reverse) { - tidy <- broom::tidy(x) - - strata <- intersect("strata", names(tidy)) %>% - list() %>% - compact() + # tidy survfit results + tidy_x <- broom::tidy(x) # adding time 0 to data frame - tidy <- tidy %>% + tidy_x <- tidy_x %>% # make strata a fct to preserve ordering - mutate_at(vars(strata), ~ factor(., levels = unique(.))) %>% - # if CI is missing, and SE is 0, make the CI the estimate - mutate_at( - vars("conf.high", "conf.low"), + dplyr::mutate_at(dplyr::vars(strata), ~ factor(., levels = unique(.))) %>% + # if CI is missing and SE is 0, use estimate as the CI + dplyr::mutate_at( + dplyr::vars("conf.high", "conf.low"), ~ ifelse(is.na(.) & .data$std.error == 0, .data$estimate, .) ) %>% - select(any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% + dplyr::select(dplyr::any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% # add data for time 0 - bind_rows( - group_by(., strata) %>% - slice(1) %>% - mutate( + dplyr::bind_rows( + dplyr::group_by(., strata) %>% + dplyr::slice(1) %>% + dplyr::mutate( time = 0, estimate = 1, conf.low = 1, conf.high = 1 ) ) %>% - ungroup() + dplyr::ungroup() # get requested estimates - df_stat <- tidy %>% + df_stat <- tidy_x %>% # find max time - group_by(., strata) %>% - mutate(time_max = max(.data$time)) %>% - ungroup() %>% + dplyr::group_by(., strata) %>% + dplyr::mutate(time_max = max(.data$time)) %>% + dplyr::ungroup() %>% # add requested timepoints - full_join( - select(tidy, strata) %>% - distinct() %>% - mutate( + dplyr::full_join( + dplyr::select(tidy_x, strata) %>% + dplyr::distinct() %>% + dplyr::mutate( time = list(.env$times), col_name = list(paste("stat", seq_len(length(.env$times)), sep = "_")) ) %>% - unnest(cols = c("time", "col_name")), - by = unlist(c(strata, "time")) + tidyr::unnest(cols = c("time", "col_name")), + by = unlist(c("strata", "time")) ) %>% # if user-specifed time is unobserved, fill estimate with previous value - arrange(strata, .data$time) %>% - group_by(strata) %>% + dplyr::arrange(.data$strata, .data$time) %>% + dplyr::group_by(.data$strata) %>% tidyr::fill( "estimate", "conf.high", "conf.low", "time_max", .direction = "down" ) %>% - ungroup() %>% + dplyr::ungroup() %>% # keep only user-specified times - filter(!is.na(.data$col_name)) %>% + dplyr::filter(!is.na(.data$col_name)) %>% # if user-specified time is after max time, make estimate NA - mutate_at( - vars("estimate", "conf.high", "conf.low"), + dplyr::mutate_at( + dplyr::vars("estimate", "conf.high", "conf.low"), ~ ifelse(.data$time > .data$time_max, NA_real_, .) ) %>% - select(-c(time_max, col_name)) + dplyr::select(-c(time_max, col_name)) # reverse probs if requested if (reverse) { - df_stat <- - df_stat %>% - mutate_at(vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% + df_stat <- df_stat %>% + dplyr::mutate_at(vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") } @@ -166,19 +156,11 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @return a tibble #' #' @examples -#' cardx:::.format_survfit_probs( -#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), -#' probs = c(0.25, 0.5, 0.75) -#' ) +#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) #' #' @keywords internal .process_survfit_probs <- function(x, probs) { - tidy <- broom::tidy(x) - - strata <- intersect("strata", names(tidy)) %>% - list() %>% - compact() - # calculate survival quantiles and add estimates to df df_stat <- purrr::map2_dfr( probs, @@ -187,8 +169,9 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { as.data.frame() %>% tibble::rownames_to_column() %>% set_names(c("strata", "estimate", "conf.low", "conf.high")) %>% - mutate(prob = .x) - ) + dplyr::mutate(prob = .x) + ) %>% + tibble::tibble() df_stat } @@ -207,32 +190,30 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @keywords internal .format_survfit_results <- function(tidy_survfit) { ret <- tidy_survfit %>% - mutate(across( - any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) + dplyr::mutate(across( + dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% - pivot_longer( + tidyr::pivot_longer( cols = any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), names_to = "stat_name", values_to = "stat" ) %>% - separate_wider_delim(strata, "=", names = c("variable", "variable_level")) + tidyr::separate_wider_delim(strata, "=", names = c("variable", "variable_level")) %>% + dplyr::arrange(variable, variable_level) - ret |> + ret %>% dplyr::left_join( .df_survfit_stat_labels(), by = "stat_name" - ) |> + ) %>% dplyr::mutate( - fmt_fn = - lapply( - .data$stat, - function(x) { - switch(is.integer(x), 0L) %||% switch(is.numeric(x), 1L) - } - ), + fmt_fn = lapply( + .data$stat, + function(x) switch(is.integer(x), 0L) %||% switch(is.numeric(x), 1L) + ), context = "survival", stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) - ) |> + ) %>% cards::tidy_ard_column_order() %>% structure(., class = c("card", class(.))) } @@ -245,6 +226,6 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { "conf.high", "CI Upper Bound", "conf.level", "CI Confidence Level", "prob", "Quantile", - "times", "Time" + "time", "Time" ) } diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index 2efab2687..0f51efdcb 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -28,7 +28,11 @@ Analysis results data for survival quantiles and x-year survival estimates, extr from a \code{\link[survival:survfit]{survival::survfit()}} model. } \details{ -Only one of either the \code{times} or \code{probs} parameters can be specified. +\itemize{ +\item Only one of either the \code{times} or \code{probs} parameters can be specified. +\item Times should be provided using the same scale as the time variable used to fit the provided +survival fit model. +} } \examples{ \dontshow{if (broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd index 32c7825d8..675a80ca6 100644 --- a/man/dot-process_survfit_probs.Rd +++ b/man/dot-process_survfit_probs.Rd @@ -20,10 +20,8 @@ a tibble Process Survival Fit For Quantile Estimates } \examples{ -cardx:::.format_survfit_probs( - survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), - probs = c(0.25, 0.5, 0.75) -) +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) } \keyword{internal} diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index b608091f4..7cdc54de2 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -24,11 +24,8 @@ a tibble Process Survival Fit For Time Estimates } \examples{ -cardx:::.format_survfit_time( - survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), - times = c(60, 180), - reverse = FALSE -) +survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) } \keyword{internal} diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md new file mode 100644 index 000000000..edd1977e2 --- /dev/null +++ b/tests/testthat/_snaps/ard_survfit.md @@ -0,0 +1,74 @@ +# ard_survfit() works with times provided + + Code + print(dplyr::mutate(ard_survfit(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), + cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 24 x 7 + Output + variable variable_level stat_name stat_label stat fmt_fn + 1 TRTA Placebo estimate Survival… 0.893 1 + 2 TRTA Placebo conf.high CI Upper… 0.966 1 + 3 TRTA Placebo conf.low CI Lower… 0.825 1 + 4 TRTA Placebo time Time 60 1 + 5 TRTA Placebo estimate Survival… 0.651 1 + 6 TRTA Placebo conf.high CI Upper… 0.783 1 + 7 TRTA Placebo conf.low CI Lower… 0.541 1 + 8 TRTA Placebo time Time 180 1 + 9 TRTA Xanomeli… estimate Survival… 0.694 1 + 10 TRTA Xanomeli… conf.high CI Upper… 0.849 1 + 11 TRTA Xanomeli… conf.low CI Lower… 0.568 1 + 12 TRTA Xanomeli… time Time 60 1 + 13 TRTA Xanomeli… estimate Survival… 0.262 1 + 14 TRTA Xanomeli… conf.high CI Upper… 0.749 1 + 15 TRTA Xanomeli… conf.low CI Lower… 0.092 1 + 16 TRTA Xanomeli… time Time 180 1 + 17 TRTA Xanomeli… estimate Survival… 0.732 1 + 18 TRTA Xanomeli… conf.high CI Upper… 0.878 1 + 19 TRTA Xanomeli… conf.low CI Lower… 0.61 1 + 20 TRTA Xanomeli… time Time 60 1 + 21 TRTA Xanomeli… estimate Survival… 0.381 1 + 22 TRTA Xanomeli… conf.high CI Upper… 0.743 1 + 23 TRTA Xanomeli… conf.low CI Lower… 0.195 1 + 24 TRTA Xanomeli… time Time 180 1 + Message + i 1 more variable: context + +# ard_survfit() works with probs provided + + Code + print(dplyr::mutate(ard_survfit(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + probs = c(0.25, 0.75)), stat = lapply(stat, function(x) ifelse(is.numeric(x), + cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 24 x 7 + Output + variable variable_level stat_name stat_label stat fmt_fn + 1 TRTA Placebo estimate Survival… 142 1 + 2 TRTA Placebo conf.high CI Upper… 181 1 + 3 TRTA Placebo conf.low CI Lower… 70 1 + 4 TRTA Placebo prob Quantile 0.25 1 + 5 TRTA Placebo estimate Survival… 184 1 + 6 TRTA Placebo conf.high CI Upper… 191 1 + 7 TRTA Placebo conf.low CI Lower… 183 1 + 8 TRTA Placebo prob Quantile 0.75 1 + 9 TRTA Xanomeli… estimate Survival… 44 1 + 10 TRTA Xanomeli… conf.high CI Upper… 180 1 + 11 TRTA Xanomeli… conf.low CI Lower… 22 1 + 12 TRTA Xanomeli… prob Quantile 0.25 1 + 13 TRTA Xanomeli… estimate Survival… 188 1 + 14 TRTA Xanomeli… conf.high CI Upper… NA 1 + 15 TRTA Xanomeli… conf.low CI Lower… 167 1 + 16 TRTA Xanomeli… prob Quantile 0.75 1 + 17 TRTA Xanomeli… estimate Survival… 49 1 + 18 TRTA Xanomeli… conf.high CI Upper… 180 1 + 19 TRTA Xanomeli… conf.low CI Lower… 37 1 + 20 TRTA Xanomeli… prob Quantile 0.25 1 + 21 TRTA Xanomeli… estimate Survival… 184 1 + 22 TRTA Xanomeli… conf.high CI Upper… NA 1 + 23 TRTA Xanomeli… conf.low CI Lower… 180 1 + 24 TRTA Xanomeli… prob Quantile 0.75 1 + Message + i 1 more variable: context + diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R new file mode 100644 index 000000000..f961c354f --- /dev/null +++ b/tests/testthat/test-ard_survfit.R @@ -0,0 +1,21 @@ +test_that("ard_survfit() works with times provided", { + expect_snapshot( + survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + +test_that("ard_survfit() works with probs provided", { + expect_snapshot( + survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(probs = c(0.25, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) From 7e2523ad630231ca614a705e622820a35aba561c Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 21:26:07 -0500 Subject: [PATCH 07/34] Fix docs --- R/ard_proportion_ci.R | 2 +- man/ard_proportion_ci.Rd | 2 +- tests/testthat/test-ard_survfit.R | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/R/ard_proportion_ci.R b/R/ard_proportion_ci.R index edb623ca3..d1f5ea593 100644 --- a/R/ard_proportion_ci.R +++ b/R/ard_proportion_ci.R @@ -14,7 +14,7 @@ #' Default is `0.95` #' @param method (`string`)\cr #' string indicating the type of confidence interval to calculate. -#' Must be one of `r formals(ard_proportion_ci)[["method"]] |> eval() |> shQuote()`. +#' Must be one of `r formals(ard_proportion_ci)[["method"]] |> eval() |> shQuote("sh")`. #' See `?proportion_ci` for details. #' @param strata,weights,max.iterations arguments passed to `proportion_ci_strat_wilson()`, #' when `method='strat_wilson'` diff --git a/man/ard_proportion_ci.Rd b/man/ard_proportion_ci.Rd index c914d64ad..0b821060e 100644 --- a/man/ard_proportion_ci.Rd +++ b/man/ard_proportion_ci.Rd @@ -36,7 +36,7 @@ when \code{method='strat_wilson'}} \item{method}{(\code{string})\cr string indicating the type of confidence interval to calculate. -Must be one of "waldcc", "wald", "clopper-pearson", "wilson", "wilsoncc", "strat_wilson", "strat_wilsoncc", "agresti-coull", "jeffreys". +Must be one of 'waldcc', 'wald', 'clopper-pearson', 'wilson', 'wilsoncc', 'strat_wilson', 'strat_wilsoncc', 'agresti-coull', 'jeffreys'. See \code{?proportion_ci} for details.} } \value{ diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index f961c354f..23ea89c7b 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -1,6 +1,6 @@ test_that("ard_survfit() works with times provided", { expect_snapshot( - survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) @@ -11,7 +11,7 @@ test_that("ard_survfit() works with times provided", { test_that("ard_survfit() works with probs provided", { expect_snapshot( - survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> ard_survfit(probs = c(0.25, 0.75)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) From a9289807d7b46954bbe0a81f23a0f5ce60339f32 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 21:42:51 -0500 Subject: [PATCH 08/34] Styler, update docs, fix failing wilcoxtest tests --- R/ard_survfit.R | 15 ++++++++++----- R/ard_wilcoxtest.R | 2 -- _pkgdown.yml | 1 + inst/WORDLIST | 2 ++ man/dot-process_survfit_probs.Rd | 2 +- man/dot-process_survfit_time.Rd | 2 +- 6 files changed, 15 insertions(+), 9 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 0f97cfad7..00c8431f6 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -56,8 +56,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # build ARD ------------------------------------------------------------------ est_type <- ifelse(is.null(probs), "times", "probs") - tidy_survfit <- switch( - est_type, + tidy_survfit <- switch(est_type, "times" = .process_survfit_time(x, times, reverse), "probs" = .process_survfit_probs(x, probs) ) @@ -70,7 +69,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @inheritParams cards::tidy_as_ard #' @inheritParams ard_survfit #' -#' @return a tibble +#' @return a `tibble` #' #' @examples #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> @@ -153,7 +152,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @inheritParams cards::tidy_as_ard #' @inheritParams ard_survfit #' -#' @return a tibble +#' @return a `tibble` #' #' @examples #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> @@ -209,7 +208,13 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { dplyr::mutate( fmt_fn = lapply( .data$stat, - function(x) switch(is.integer(x), 0L) %||% switch(is.numeric(x), 1L) + function(x) { + switch(is.integer(x), + 0L + ) %||% switch(is.numeric(x), + 1L + ) + } ), context = "survival", stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) diff --git a/R/ard_wilcoxtest.R b/R/ard_wilcoxtest.R index 301592434..071c77ba8 100644 --- a/R/ard_wilcoxtest.R +++ b/R/ard_wilcoxtest.R @@ -56,7 +56,6 @@ ard_wilcoxtest <- function(data, by, variable, ...) { check_scalar(by) check_scalar(variable) - browser() # build ARD ------------------------------------------------------------------ .format_wilcoxtest_results( by = by, @@ -136,7 +135,6 @@ ard_paired_wilcoxtest <- function(data, by, variable, id, ...) { #' #' @keywords internal .format_wilcoxtest_results <- function(by, variable, lst_tidy, paired, ...) { - browser() # build ARD ------------------------------------------------------------------ ret <- cards::tidy_as_ard( diff --git a/_pkgdown.yml b/_pkgdown.yml index 3f30f9016..18285a3bb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -36,6 +36,7 @@ reference: - contents: - ard_proportion_ci - ard_regression + - ard_survfit - title: "Helpers" - contents: diff --git a/inst/WORDLIST b/inst/WORDLIST index 243f05fcc..e2d4bbd5b 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -8,12 +8,14 @@ Jeffreys Lifecycle McNemar's Newcombe +Rua Su XG Xin agresti clopper coull +de funder jeffreys pearson diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd index 675a80ca6..4bfa3e700 100644 --- a/man/dot-process_survfit_probs.Rd +++ b/man/dot-process_survfit_probs.Rd @@ -14,7 +14,7 @@ a \code{\link[survival:survfit]{survival::survfit()}} object. See below for deta a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} } \value{ -a tibble +a \code{tibble} } \description{ Process Survival Fit For Quantile Estimates diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index 7cdc54de2..24f927ea1 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -18,7 +18,7 @@ Flip the probability reported, i.e. \code{1 - estimate}. Default is \code{FALSE} \code{probs} is specified.} } \value{ -a tibble +a \code{tibble} } \description{ Process Survival Fit For Time Estimates From 6d4e08821c32bcdb74834d3e1823cab3e7168433 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 21:52:10 -0500 Subject: [PATCH 09/34] Fix tests --- R/ard_survfit.R | 12 +-- man/dot-format_survfit_results.Rd | 2 +- man/dot-process_survfit_probs.Rd | 2 +- man/dot-process_survfit_time.Rd | 2 +- tests/testthat/_snaps/ard_survfit.md | 116 +++++++++++++-------------- 5 files changed, 67 insertions(+), 67 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 00c8431f6..e9bd3e308 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -72,7 +72,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @return a `tibble` #' #' @examples -#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> #' cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) #' #' @keywords internal @@ -155,7 +155,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @return a `tibble` #' #' @examples -#' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +#' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> #' cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) #' #' @keywords internal @@ -183,7 +183,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' #' @examples #' cardx:::.format_survfit_results( -#' broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) +#' broom::tidy(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) #' ) #' #' @keywords internal @@ -197,8 +197,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { names_to = "stat_name", values_to = "stat" ) %>% - tidyr::separate_wider_delim(strata, "=", names = c("variable", "variable_level")) %>% - dplyr::arrange(variable, variable_level) + tidyr::separate_wider_delim(strata, "=", names = c("variable", "variable_level")) ret %>% dplyr::left_join( @@ -219,8 +218,9 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { context = "survival", stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) ) %>% + structure(., class = c("card", class(.))) %>% cards::tidy_ard_column_order() %>% - structure(., class = c("card", class(.))) + cards::tidy_ard_row_order() } .df_survfit_stat_labels <- function() { diff --git a/man/dot-format_survfit_results.Rd b/man/dot-format_survfit_results.Rd index c4f159693..d1a1e36fb 100644 --- a/man/dot-format_survfit_results.Rd +++ b/man/dot-format_survfit_results.Rd @@ -14,7 +14,7 @@ Convert Tidied Survival Fit to ARD } \examples{ cardx:::.format_survfit_results( - broom::tidy(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) + broom::tidy(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE)) ) } diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd index 4bfa3e700..4e2a89923 100644 --- a/man/dot-process_survfit_probs.Rd +++ b/man/dot-process_survfit_probs.Rd @@ -20,7 +20,7 @@ a \code{tibble} Process Survival Fit For Quantile Estimates } \examples{ -survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> cardx:::.process_survfit_probs(probs = c(0.25, 0.75)) } diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index 24f927ea1..01ce138ce 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -24,7 +24,7 @@ a \code{tibble} Process Survival Fit For Time Estimates } \examples{ -survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> +survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) } diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index edd1977e2..5356c6b8a 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -1,74 +1,74 @@ # ard_survfit() works with times provided Code - print(dplyr::mutate(ard_survfit(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), - times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), - cards::round5(x, 3), x))), n = Inf) + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ + TRTA, cards::ADTTE), times = c(60, 180)), stat = lapply(stat, function(x) + ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 24 x 7 Output - variable variable_level stat_name stat_label stat fmt_fn - 1 TRTA Placebo estimate Survival… 0.893 1 - 2 TRTA Placebo conf.high CI Upper… 0.966 1 - 3 TRTA Placebo conf.low CI Lower… 0.825 1 - 4 TRTA Placebo time Time 60 1 - 5 TRTA Placebo estimate Survival… 0.651 1 - 6 TRTA Placebo conf.high CI Upper… 0.783 1 - 7 TRTA Placebo conf.low CI Lower… 0.541 1 - 8 TRTA Placebo time Time 180 1 - 9 TRTA Xanomeli… estimate Survival… 0.694 1 - 10 TRTA Xanomeli… conf.high CI Upper… 0.849 1 - 11 TRTA Xanomeli… conf.low CI Lower… 0.568 1 - 12 TRTA Xanomeli… time Time 60 1 - 13 TRTA Xanomeli… estimate Survival… 0.262 1 - 14 TRTA Xanomeli… conf.high CI Upper… 0.749 1 - 15 TRTA Xanomeli… conf.low CI Lower… 0.092 1 - 16 TRTA Xanomeli… time Time 180 1 - 17 TRTA Xanomeli… estimate Survival… 0.732 1 - 18 TRTA Xanomeli… conf.high CI Upper… 0.878 1 - 19 TRTA Xanomeli… conf.low CI Lower… 0.61 1 - 20 TRTA Xanomeli… time Time 60 1 - 21 TRTA Xanomeli… estimate Survival… 0.381 1 - 22 TRTA Xanomeli… conf.high CI Upper… 0.743 1 - 23 TRTA Xanomeli… conf.low CI Lower… 0.195 1 - 24 TRTA Xanomeli… time Time 180 1 + variable variable_level context stat_name stat_label stat + 1 TRTA Placebo survival estimate Survival… 0.893 + 2 TRTA Placebo survival conf.high CI Upper… 0.966 + 3 TRTA Placebo survival conf.low CI Lower… 0.825 + 4 TRTA Placebo survival time Time 60 + 5 TRTA Placebo survival estimate Survival… 0.651 + 6 TRTA Placebo survival conf.high CI Upper… 0.783 + 7 TRTA Placebo survival conf.low CI Lower… 0.541 + 8 TRTA Placebo survival time Time 180 + 9 TRTA Xanomeli… survival estimate Survival… 0.694 + 10 TRTA Xanomeli… survival conf.high CI Upper… 0.849 + 11 TRTA Xanomeli… survival conf.low CI Lower… 0.568 + 12 TRTA Xanomeli… survival time Time 60 + 13 TRTA Xanomeli… survival estimate Survival… 0.262 + 14 TRTA Xanomeli… survival conf.high CI Upper… 0.749 + 15 TRTA Xanomeli… survival conf.low CI Lower… 0.092 + 16 TRTA Xanomeli… survival time Time 180 + 17 TRTA Xanomeli… survival estimate Survival… 0.732 + 18 TRTA Xanomeli… survival conf.high CI Upper… 0.878 + 19 TRTA Xanomeli… survival conf.low CI Lower… 0.61 + 20 TRTA Xanomeli… survival time Time 60 + 21 TRTA Xanomeli… survival estimate Survival… 0.381 + 22 TRTA Xanomeli… survival conf.high CI Upper… 0.743 + 23 TRTA Xanomeli… survival conf.low CI Lower… 0.195 + 24 TRTA Xanomeli… survival time Time 180 Message - i 1 more variable: context + i 1 more variable: fmt_fn # ard_survfit() works with probs provided Code - print(dplyr::mutate(ard_survfit(survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), - probs = c(0.25, 0.75)), stat = lapply(stat, function(x) ifelse(is.numeric(x), - cards::round5(x, 3), x))), n = Inf) + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ + TRTA, cards::ADTTE), probs = c(0.25, 0.75)), stat = lapply(stat, function(x) + ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 24 x 7 Output - variable variable_level stat_name stat_label stat fmt_fn - 1 TRTA Placebo estimate Survival… 142 1 - 2 TRTA Placebo conf.high CI Upper… 181 1 - 3 TRTA Placebo conf.low CI Lower… 70 1 - 4 TRTA Placebo prob Quantile 0.25 1 - 5 TRTA Placebo estimate Survival… 184 1 - 6 TRTA Placebo conf.high CI Upper… 191 1 - 7 TRTA Placebo conf.low CI Lower… 183 1 - 8 TRTA Placebo prob Quantile 0.75 1 - 9 TRTA Xanomeli… estimate Survival… 44 1 - 10 TRTA Xanomeli… conf.high CI Upper… 180 1 - 11 TRTA Xanomeli… conf.low CI Lower… 22 1 - 12 TRTA Xanomeli… prob Quantile 0.25 1 - 13 TRTA Xanomeli… estimate Survival… 188 1 - 14 TRTA Xanomeli… conf.high CI Upper… NA 1 - 15 TRTA Xanomeli… conf.low CI Lower… 167 1 - 16 TRTA Xanomeli… prob Quantile 0.75 1 - 17 TRTA Xanomeli… estimate Survival… 49 1 - 18 TRTA Xanomeli… conf.high CI Upper… 180 1 - 19 TRTA Xanomeli… conf.low CI Lower… 37 1 - 20 TRTA Xanomeli… prob Quantile 0.25 1 - 21 TRTA Xanomeli… estimate Survival… 184 1 - 22 TRTA Xanomeli… conf.high CI Upper… NA 1 - 23 TRTA Xanomeli… conf.low CI Lower… 180 1 - 24 TRTA Xanomeli… prob Quantile 0.75 1 + variable variable_level context stat_name stat_label stat + 1 TRTA Placebo survival estimate Survival… 142 + 2 TRTA Placebo survival conf.high CI Upper… 181 + 3 TRTA Placebo survival conf.low CI Lower… 70 + 4 TRTA Placebo survival prob Quantile 0.25 + 5 TRTA Xanomeli… survival estimate Survival… 44 + 6 TRTA Xanomeli… survival conf.high CI Upper… 180 + 7 TRTA Xanomeli… survival conf.low CI Lower… 22 + 8 TRTA Xanomeli… survival prob Quantile 0.25 + 9 TRTA Xanomeli… survival estimate Survival… 49 + 10 TRTA Xanomeli… survival conf.high CI Upper… 180 + 11 TRTA Xanomeli… survival conf.low CI Lower… 37 + 12 TRTA Xanomeli… survival prob Quantile 0.25 + 13 TRTA Placebo survival estimate Survival… 184 + 14 TRTA Placebo survival conf.high CI Upper… 191 + 15 TRTA Placebo survival conf.low CI Lower… 183 + 16 TRTA Placebo survival prob Quantile 0.75 + 17 TRTA Xanomeli… survival estimate Survival… 188 + 18 TRTA Xanomeli… survival conf.high CI Upper… NA + 19 TRTA Xanomeli… survival conf.low CI Lower… 167 + 20 TRTA Xanomeli… survival prob Quantile 0.75 + 21 TRTA Xanomeli… survival estimate Survival… 184 + 22 TRTA Xanomeli… survival conf.high CI Upper… NA + 23 TRTA Xanomeli… survival conf.low CI Lower… 180 + 24 TRTA Xanomeli… survival prob Quantile 0.75 Message - i 1 more variable: context + i 1 more variable: fmt_fn From 0bf18210e761cf50926091b10e23c0fcd93191c6 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 22:04:15 -0500 Subject: [PATCH 10/34] Increase test coverage --- R/ard_survfit.R | 2 +- tests/testthat/_snaps/ard_survfit.md | 59 +++++++++++++++++++++++++++- tests/testthat/test-ard_survfit.R | 26 +++++++++++- 3 files changed, 83 insertions(+), 4 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index e9bd3e308..6f4ff11ea 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -140,7 +140,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # reverse probs if requested if (reverse) { df_stat <- df_stat %>% - dplyr::mutate_at(vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% + dplyr::mutate_at(dplyr::vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") } diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 5356c6b8a..a435f07ef 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -35,13 +35,51 @@ Message i 1 more variable: fmt_fn +# ard_survfit() works with reverse=TRUE + + Code + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ + TRTA, cards::ADTTE), times = c(60, 180), reverse = TRUE), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 24 x 7 + Output + variable variable_level context stat_name stat_label stat + 1 TRTA Placebo survival estimate Survival… 0.107 + 2 TRTA Placebo survival conf.high CI Upper… 0.175 + 3 TRTA Placebo survival conf.low CI Lower… 0.034 + 4 TRTA Placebo survival time Time 60 + 5 TRTA Placebo survival estimate Survival… 0.349 + 6 TRTA Placebo survival conf.high CI Upper… 0.459 + 7 TRTA Placebo survival conf.low CI Lower… 0.217 + 8 TRTA Placebo survival time Time 180 + 9 TRTA Xanomeli… survival estimate Survival… 0.306 + 10 TRTA Xanomeli… survival conf.high CI Upper… 0.432 + 11 TRTA Xanomeli… survival conf.low CI Lower… 0.151 + 12 TRTA Xanomeli… survival time Time 60 + 13 TRTA Xanomeli… survival estimate Survival… 0.738 + 14 TRTA Xanomeli… survival conf.high CI Upper… 0.908 + 15 TRTA Xanomeli… survival conf.low CI Lower… 0.251 + 16 TRTA Xanomeli… survival time Time 180 + 17 TRTA Xanomeli… survival estimate Survival… 0.268 + 18 TRTA Xanomeli… survival conf.high CI Upper… 0.39 + 19 TRTA Xanomeli… survival conf.low CI Lower… 0.122 + 20 TRTA Xanomeli… survival time Time 60 + 21 TRTA Xanomeli… survival estimate Survival… 0.619 + 22 TRTA Xanomeli… survival conf.high CI Upper… 0.805 + 23 TRTA Xanomeli… survival conf.low CI Lower… 0.257 + 24 TRTA Xanomeli… survival time Time 180 + Message + i 1 more variable: fmt_fn + # ard_survfit() works with probs provided Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ - TRTA, cards::ADTTE), probs = c(0.25, 0.75)), stat = lapply(stat, function(x) - ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + TRTA, cards::ADTTE), probs = c(0.25, 0.75), reverse = TRUE), stat = lapply( + stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message + The `reverse=TRUE` argument is ignored for survival quantile estimation. {cards} data frame: 24 x 7 Output variable variable_level context stat_name stat_label stat @@ -72,3 +110,20 @@ Message i 1 more variable: fmt_fn +# ard_survfit() errors are properly handled + + Code + ard_survfit("not_survfit") + Condition + Error in `ard_survfit()`: + ! The `x` argument must be class created using the `survival::survfit()` function. + +--- + + Code + ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + times = 100, probs = c(0.25, 0.75)) + Condition + Error in `ard_survfit()`: + ! One and only one of `times` and `probs` must be specified. + diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 23ea89c7b..5ae8560b9 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -9,13 +9,37 @@ test_that("ard_survfit() works with times provided", { ) }) +test_that("ard_survfit() works with reverse=TRUE", { + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(times = c(60, 180), reverse = TRUE) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + test_that("ard_survfit() works with probs provided", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_survfit(probs = c(0.25, 0.75)) |> + ard_survfit(probs = c(0.25, 0.75), reverse = TRUE) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> print(n = Inf) ) }) + +test_that("ard_survfit() errors are properly handled", { + expect_snapshot( + ard_survfit("not_survfit"), + error = TRUE + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(times = 100, probs = c(0.25, 0.75)), + error = TRUE + ) +}) From a4fcc9b6c9340ba99099599f6f0f213bb5eb2e15 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 22:48:17 -0500 Subject: [PATCH 11/34] Fix imports --- DESCRIPTION | 2 ++ R/ard_survfit.R | 15 ++++++++------- 2 files changed, 10 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 117b95edf..c69aadf2c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,7 +19,9 @@ Imports: cli (>= 3.6.1), dplyr (>= 1.1.2), glue (>= 1.6.2), + purrr (>= 1.0.1), rlang (>= 1.1.1), + tibble (>= 3.2.1), tidyr (>= 1.3.0) Suggests: broom (>= 1.0.5), diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 6f4ff11ea..36c988361 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -83,7 +83,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # adding time 0 to data frame tidy_x <- tidy_x %>% # make strata a fct to preserve ordering - dplyr::mutate_at(dplyr::vars(strata), ~ factor(., levels = unique(.))) %>% + dplyr::mutate_at("strata", ~ factor(., levels = unique(.))) %>% # if CI is missing and SE is 0, use estimate as the CI dplyr::mutate_at( dplyr::vars("conf.high", "conf.low"), @@ -92,7 +92,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { dplyr::select(dplyr::any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% # add data for time 0 dplyr::bind_rows( - dplyr::group_by(., strata) %>% + dplyr::group_by(., .data$strata) %>% dplyr::slice(1) %>% dplyr::mutate( time = 0, @@ -106,12 +106,13 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # get requested estimates df_stat <- tidy_x %>% # find max time - dplyr::group_by(., strata) %>% + dplyr::group_by(., .data$strata) %>% dplyr::mutate(time_max = max(.data$time)) %>% dplyr::ungroup() %>% # add requested timepoints dplyr::full_join( - dplyr::select(tidy_x, strata) %>% + tidy_x %>% + dplyr::select("strata") %>% dplyr::distinct() %>% dplyr::mutate( time = list(.env$times), @@ -135,7 +136,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { dplyr::vars("estimate", "conf.high", "conf.low"), ~ ifelse(.data$time > .data$time_max, NA_real_, .) ) %>% - dplyr::select(-c(time_max, col_name)) + dplyr::select(!dplyr::any_of(c("time_max", "col_name"))) # reverse probs if requested if (reverse) { @@ -189,7 +190,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @keywords internal .format_survfit_results <- function(tidy_survfit) { ret <- tidy_survfit %>% - dplyr::mutate(across( + dplyr::mutate(dplyr::across( dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% tidyr::pivot_longer( @@ -197,7 +198,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { names_to = "stat_name", values_to = "stat" ) %>% - tidyr::separate_wider_delim(strata, "=", names = c("variable", "variable_level")) + tidyr::separate_wider_delim("strata", "=", names = c("variable", "variable_level")) ret %>% dplyr::left_join( From 9e69179e0a1ad8840192beae93ccb8f246a1e9b4 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 21 Feb 2024 22:56:52 -0500 Subject: [PATCH 12/34] Styler --- R/ard_survfit.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 36c988361..4d091a065 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -112,7 +112,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { # add requested timepoints dplyr::full_join( tidy_x %>% - dplyr::select("strata") %>% + dplyr::select("strata") %>% dplyr::distinct() %>% dplyr::mutate( time = list(.env$times), From 56e793c820e2b35f76e581259f9ba7878e568cc7 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 29 Feb 2024 20:05:19 -0500 Subject: [PATCH 13/34] Remove dependencies --- DESCRIPTION | 2 -- R/ard_survfit.R | 11 +++++++---- man/dot-process_survfit_probs.Rd | 2 +- 3 files changed, 8 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index e28373586..a9269f169 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -19,9 +19,7 @@ Imports: cli (>= 3.6.1), dplyr (>= 1.1.2), glue (>= 1.6.2), - purrr (>= 1.0.1), rlang (>= 1.1.1), - tibble (>= 3.2.1), tidyr (>= 1.3.0) Suggests: broom (>= 1.0.5), diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 4d091a065..1caaf015f 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -162,16 +162,19 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' @keywords internal .process_survfit_probs <- function(x, probs) { # calculate survival quantiles and add estimates to df - df_stat <- purrr::map2_dfr( + df_stat <- map2( probs, seq_along(probs), ~ stats::quantile(x, probs = .x) %>% as.data.frame() %>% - tibble::rownames_to_column() %>% - set_names(c("strata", "estimate", "conf.low", "conf.high")) %>% + set_names(c("estimate", "conf.low", "conf.high")) %>% + dplyr::mutate(strata = row.names(.)) %>% + dplyr::select(strata, estimate, conf.low, conf.high) %>% dplyr::mutate(prob = .x) ) %>% - tibble::tibble() + dplyr::bind_rows() %>% + `rownames<-`(NULL) %>% + dplyr::as_tibble() df_stat } diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd index 4e2a89923..1efb9773a 100644 --- a/man/dot-process_survfit_probs.Rd +++ b/man/dot-process_survfit_probs.Rd @@ -14,7 +14,7 @@ a \code{\link[survival:survfit]{survival::survfit()}} object. See below for deta a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} } \value{ -a \code{tibble} +a \code{data.frame} } \description{ Process Survival Fit For Quantile Estimates From 365d61ee7ded3e397d3d873b67fbd0268ef0abd1 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 29 Feb 2024 20:05:56 -0500 Subject: [PATCH 14/34] Support multi-state models --- R/ard_survfit.R | 22 +++++++++++++++++++--- 1 file changed, 19 insertions(+), 3 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 1caaf015f..31ed614d2 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -77,6 +77,22 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' #' @keywords internal .process_survfit_time <- function(x, times, reverse) { + # process multi-state models + multi_state <- inherits(x, "survfitms") + if (multi_state == TRUE) { + # selecting state to show + state <- unique(tidy$state) %>% + setdiff("(s0)") %>% + purrr::pluck(1) + + if (identical(quiet, FALSE)) { + rlang::inform(glue( + "tbl_survfit: Multi-state model detected. Showing probabilities into state '{state}'" + )) + } + tidy <- dplyr::filter(tidy, .data$state == .env$state) + } + # tidy survfit results tidy_x <- broom::tidy(x) @@ -96,9 +112,9 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { dplyr::slice(1) %>% dplyr::mutate( time = 0, - estimate = 1, - conf.low = 1, - conf.high = 1 + estimate = ifelse(multi_state, 0, 1), + conf.low = ifelse(multi_state, 0, 1), + conf.high = ifelse(multi_state, 0, 1) ) ) %>% dplyr::ungroup() From b83aa8941bfc23b757f5adc9a8f28af1e59d695d Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 29 Feb 2024 20:06:38 -0500 Subject: [PATCH 15/34] Enable types survival, risk, and cumhaz --- R/ard_survfit.R | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 31ed614d2..83108e183 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -10,9 +10,19 @@ #' a vector of times for which to return survival probabilities. #' @param probs (`numeric`)\cr #' a vector of probabilities with values in (0,1) specifying the survival quantiles to return. -#' @param reverse (`logical`)\cr -#' Flip the probability reported, i.e. `1 - estimate`. Default is `FALSE`. Only applies when -#' `probs` is specified. +#' @param type (`character` or `NULL`)\cr +#' type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise `type` +#' is ignored. Default is `"survival"`. +#' Must be one of the following: +#' ```{r, echo = FALSE} +#' dplyr::tribble( +#' ~type, ~transformation, +#' '`"survival"`', '`x`', +#' '`"risk"`', '`1 - x`', +#' '`"cumhaz"`', '`-log(x)`', +#' ) %>% +#' knitr::kable() +#' ``` #' #' @return an ARD data frame of class 'card' #' @name ard_survfit @@ -34,13 +44,13 @@ NULL #' @rdname ard_survfit #' @export -ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { +ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "risk", "cumhaz")) { # check installed packages --------------------------------------------------- cards::check_pkg_installed("survival", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(x) - check_binary(reverse) + check_class(type, "character", allow_empty = TRUE) if (!is.null(probs)) check_range(probs, c(0, 1)) if (!all(inherits(x, "survfit"))) { cli::cli_abort( @@ -50,14 +60,14 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { if (sum(is.null(times), is.null(probs)) != 1) { cli::cli_abort("One and only one of {.arg times} and {.arg probs} must be specified.") } - if (reverse && !is.null(probs)) { - cli::cli_inform("The {.code reverse=TRUE} argument is ignored for survival quantile estimation.") + if (!is.null(type) && !is.null(probs)) { + cli::cli_inform("The {.arg type} argument is ignored for survival quantile estimation.") } # build ARD ------------------------------------------------------------------ est_type <- ifelse(is.null(probs), "times", "probs") tidy_survfit <- switch(est_type, - "times" = .process_survfit_time(x, times, reverse), + "times" = .process_survfit_time(x, times, type), "probs" = .process_survfit_probs(x, probs) ) @@ -73,10 +83,10 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { #' #' @examples #' survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> -#' cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) +#' cardx:::.process_survfit_time(times = c(60, 180), type = "risk") #' #' @keywords internal -.process_survfit_time <- function(x, times, reverse) { +.process_survfit_time <- function(x, times, type) { # process multi-state models multi_state <- inherits(x, "survfitms") if (multi_state == TRUE) { @@ -154,10 +164,13 @@ ard_survfit <- function(x, times = NULL, probs = NULL, reverse = FALSE) { ) %>% dplyr::select(!dplyr::any_of(c("time_max", "col_name"))) - # reverse probs if requested - if (reverse) { + # convert estimates to requested type + if (type != "survival") { df_stat <- df_stat %>% - dplyr::mutate_at(dplyr::vars("estimate", "conf.low", "conf.high"), ~ 1 - .) %>% + dplyr::mutate_at( + dplyr::vars("estimate", "conf.low", "conf.high"), + ~ dplyr::if_else(type == "risk", 1 - ., -log(.)) + ) %>% dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") } From 481cf21343e8c7e266e816e0f71a27df5ae53dd9 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 29 Feb 2024 20:18:00 -0500 Subject: [PATCH 16/34] Update docs --- man/ard_survfit.Rd | 19 +++++++++++++++---- man/dot-process_survfit_probs.Rd | 2 +- man/dot-process_survfit_time.Rd | 16 +++++++++++----- 3 files changed, 27 insertions(+), 10 deletions(-) diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index 0f51efdcb..70083d958 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -4,7 +4,12 @@ \alias{ard_survfit} \title{ARD Survival Estimates} \usage{ -ard_survfit(x, times = NULL, probs = NULL, reverse = FALSE) +ard_survfit( + x, + times = NULL, + probs = NULL, + type = c("survival", "risk", "cumhaz") +) } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr @@ -16,9 +21,15 @@ a vector of times for which to return survival probabilities.} \item{probs}{(\code{numeric})\cr a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} -\item{reverse}{(\code{logical})\cr -Flip the probability reported, i.e. \code{1 - estimate}. Default is \code{FALSE}. Only applies when -\code{probs} is specified.} +\item{type}{(\code{character} or \code{NULL})\cr +type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} +is ignored. Default is \code{"survival"}. +Must be one of the following:\tabular{ll}{ + type \tab transformation \cr + \code{"survival"} \tab \code{x} \cr + \code{"risk"} \tab \code{1 - x} \cr + \code{"cumhaz"} \tab \code{-log(x)} \cr +}} } \value{ an ARD data frame of class 'card' diff --git a/man/dot-process_survfit_probs.Rd b/man/dot-process_survfit_probs.Rd index 1efb9773a..4e2a89923 100644 --- a/man/dot-process_survfit_probs.Rd +++ b/man/dot-process_survfit_probs.Rd @@ -14,7 +14,7 @@ a \code{\link[survival:survfit]{survival::survfit()}} object. See below for deta a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} } \value{ -a \code{data.frame} +a \code{tibble} } \description{ Process Survival Fit For Quantile Estimates diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index 01ce138ce..d9133779a 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -4,7 +4,7 @@ \alias{.process_survfit_time} \title{Process Survival Fit For Time Estimates} \usage{ -.process_survfit_time(x, times, reverse) +.process_survfit_time(x, times, type) } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr @@ -13,9 +13,15 @@ a \code{\link[survival:survfit]{survival::survfit()}} object. See below for deta \item{times}{(\code{numeric})\cr a vector of times for which to return survival probabilities.} -\item{reverse}{(\code{logical})\cr -Flip the probability reported, i.e. \code{1 - estimate}. Default is \code{FALSE}. Only applies when -\code{probs} is specified.} +\item{type}{(\code{character} or \code{NULL})\cr +type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} +is ignored. Default is \code{"survival"}. +Must be one of the following:\tabular{ll}{ + type \tab transformation \cr + \code{"survival"} \tab \code{x} \cr + \code{"risk"} \tab \code{1 - x} \cr + \code{"cumhaz"} \tab \code{-log(x)} \cr +}} } \value{ a \code{tibble} @@ -25,7 +31,7 @@ Process Survival Fit For Time Estimates } \examples{ survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - cardx:::.process_survfit_time(times = c(60, 180), reverse = FALSE) + cardx:::.process_survfit_time(times = c(60, 180), type = "risk") } \keyword{internal} From 60cd24b6684acdf5edb900af587950e902cd1d0f Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 29 Feb 2024 21:05:13 -0500 Subject: [PATCH 17/34] Update messaging, tests --- R/ard_survfit.R | 22 +++++---- tests/testthat/_snaps/ard_survfit.md | 67 ++++++++++++++++------------ tests/testthat/test-ard_survfit.R | 12 +++-- 3 files changed, 61 insertions(+), 40 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 83108e183..e6e94f4ab 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -44,13 +44,13 @@ NULL #' @rdname ard_survfit #' @export -ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "risk", "cumhaz")) { +ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # check installed packages --------------------------------------------------- cards::check_pkg_installed("survival", reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(x) - check_class(type, "character", allow_empty = TRUE) + check_class(type, "character") if (!is.null(probs)) check_range(probs, c(0, 1)) if (!all(inherits(x, "survfit"))) { cli::cli_abort( @@ -60,7 +60,12 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "ris if (sum(is.null(times), is.null(probs)) != 1) { cli::cli_abort("One and only one of {.arg times} and {.arg probs} must be specified.") } - if (!is.null(type) && !is.null(probs)) { + if (!is.null(times) && !is.null(type) && !type %in% c("survival", "risk", "cumhaz")) { + cli::cli_abort( + "The {.arg type} argument is {.val {type}} but must be one of {.val survival}, {.val risk}, or {.val cumhaz}." + ) + } + if (type != "survival" && !is.null(probs)) { cli::cli_inform("The {.arg type} argument is ignored for survival quantile estimation.") } @@ -162,15 +167,16 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "ris dplyr::vars("estimate", "conf.high", "conf.low"), ~ ifelse(.data$time > .data$time_max, NA_real_, .) ) %>% + dplyr::mutate(context = type) %>% dplyr::select(!dplyr::any_of(c("time_max", "col_name"))) # convert estimates to requested type if (type != "survival") { df_stat <- df_stat %>% - dplyr::mutate_at( - dplyr::vars("estimate", "conf.low", "conf.high"), - ~ dplyr::if_else(type == "risk", 1 - ., -log(.)) - ) %>% + dplyr::mutate(across( + any_of(c("estimate", "conf.low", "conf.high")), + if (type == "cumhaz") ~ -log(.x) else ~ 1 - .x + )) %>% dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") } @@ -203,6 +209,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "ris ) %>% dplyr::bind_rows() %>% `rownames<-`(NULL) %>% + dplyr::mutate(context = "survival") %>% dplyr::as_tibble() df_stat @@ -248,7 +255,6 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = c("survival", "ris ) } ), - context = "survival", stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) ) %>% structure(., class = c("card", class(.))) %>% diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index a435f07ef..958310056 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -35,40 +35,40 @@ Message i 1 more variable: fmt_fn -# ard_survfit() works with reverse=TRUE +# ard_survfit() works with different type Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ - TRTA, cards::ADTTE), times = c(60, 180), reverse = TRUE), stat = lapply(stat, + TRTA, cards::ADTTE), times = c(60, 180), type = "risk"), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 24 x 7 Output - variable variable_level context stat_name stat_label stat - 1 TRTA Placebo survival estimate Survival… 0.107 - 2 TRTA Placebo survival conf.high CI Upper… 0.175 - 3 TRTA Placebo survival conf.low CI Lower… 0.034 - 4 TRTA Placebo survival time Time 60 - 5 TRTA Placebo survival estimate Survival… 0.349 - 6 TRTA Placebo survival conf.high CI Upper… 0.459 - 7 TRTA Placebo survival conf.low CI Lower… 0.217 - 8 TRTA Placebo survival time Time 180 - 9 TRTA Xanomeli… survival estimate Survival… 0.306 - 10 TRTA Xanomeli… survival conf.high CI Upper… 0.432 - 11 TRTA Xanomeli… survival conf.low CI Lower… 0.151 - 12 TRTA Xanomeli… survival time Time 60 - 13 TRTA Xanomeli… survival estimate Survival… 0.738 - 14 TRTA Xanomeli… survival conf.high CI Upper… 0.908 - 15 TRTA Xanomeli… survival conf.low CI Lower… 0.251 - 16 TRTA Xanomeli… survival time Time 180 - 17 TRTA Xanomeli… survival estimate Survival… 0.268 - 18 TRTA Xanomeli… survival conf.high CI Upper… 0.39 - 19 TRTA Xanomeli… survival conf.low CI Lower… 0.122 - 20 TRTA Xanomeli… survival time Time 60 - 21 TRTA Xanomeli… survival estimate Survival… 0.619 - 22 TRTA Xanomeli… survival conf.high CI Upper… 0.805 - 23 TRTA Xanomeli… survival conf.low CI Lower… 0.257 - 24 TRTA Xanomeli… survival time Time 180 + variable variable_level context stat_name stat_label stat + 1 TRTA Placebo risk estimate Survival… 0.107 + 2 TRTA Placebo risk conf.high CI Upper… 0.175 + 3 TRTA Placebo risk conf.low CI Lower… 0.034 + 4 TRTA Placebo risk time Time 60 + 5 TRTA Placebo risk estimate Survival… 0.349 + 6 TRTA Placebo risk conf.high CI Upper… 0.459 + 7 TRTA Placebo risk conf.low CI Lower… 0.217 + 8 TRTA Placebo risk time Time 180 + 9 TRTA Xanomeli… risk estimate Survival… 0.306 + 10 TRTA Xanomeli… risk conf.high CI Upper… 0.432 + 11 TRTA Xanomeli… risk conf.low CI Lower… 0.151 + 12 TRTA Xanomeli… risk time Time 60 + 13 TRTA Xanomeli… risk estimate Survival… 0.738 + 14 TRTA Xanomeli… risk conf.high CI Upper… 0.908 + 15 TRTA Xanomeli… risk conf.low CI Lower… 0.251 + 16 TRTA Xanomeli… risk time Time 180 + 17 TRTA Xanomeli… risk estimate Survival… 0.268 + 18 TRTA Xanomeli… risk conf.high CI Upper… 0.39 + 19 TRTA Xanomeli… risk conf.low CI Lower… 0.122 + 20 TRTA Xanomeli… risk time Time 60 + 21 TRTA Xanomeli… risk estimate Survival… 0.619 + 22 TRTA Xanomeli… risk conf.high CI Upper… 0.805 + 23 TRTA Xanomeli… risk conf.low CI Lower… 0.257 + 24 TRTA Xanomeli… risk time Time 180 Message i 1 more variable: fmt_fn @@ -76,10 +76,10 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ - TRTA, cards::ADTTE), probs = c(0.25, 0.75), reverse = TRUE), stat = lapply( + TRTA, cards::ADTTE), probs = c(0.25, 0.75), type = "cumhaz"), stat = lapply( stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - The `reverse=TRUE` argument is ignored for survival quantile estimation. + The `type` argument is ignored for survival quantile estimation. {cards} data frame: 24 x 7 Output variable variable_level context stat_name stat_label stat @@ -118,6 +118,15 @@ Error in `ard_survfit()`: ! The `x` argument must be class created using the `survival::survfit()` function. +--- + + Code + ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE), + times = 100, type = "notatype") + Condition + Error in `ard_survfit()`: + ! The `type` argument is "notatype" but must be one of "survival", "risk", or "cumhaz". + --- Code diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 5ae8560b9..2c6a31b4a 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -9,10 +9,10 @@ test_that("ard_survfit() works with times provided", { ) }) -test_that("ard_survfit() works with reverse=TRUE", { +test_that("ard_survfit() works with different type", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_survfit(times = c(60, 180), reverse = TRUE) |> + ard_survfit(times = c(60, 180), type = "risk") |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> @@ -23,7 +23,7 @@ test_that("ard_survfit() works with reverse=TRUE", { test_that("ard_survfit() works with probs provided", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_survfit(probs = c(0.25, 0.75), reverse = TRUE) |> + ard_survfit(probs = c(0.25, 0.75), type = "cumhaz") |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> @@ -37,6 +37,12 @@ test_that("ard_survfit() errors are properly handled", { error = TRUE ) + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> + ard_survfit(times = 100, type = "notatype"), + error = TRUE + ) + expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> ard_survfit(times = 100, probs = c(0.25, 0.75)), From e50c47d2ed6f259b2302755e7f9eee0d66bc6675 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 1 Mar 2024 10:54:38 -0500 Subject: [PATCH 18/34] Fix warnings --- R/ard_survfit.R | 17 +++++------------ man/ard_survfit.Rd | 7 +------ 2 files changed, 6 insertions(+), 18 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index e6e94f4ab..d2ff1fc85 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -96,16 +96,9 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { multi_state <- inherits(x, "survfitms") if (multi_state == TRUE) { # selecting state to show - state <- unique(tidy$state) %>% - setdiff("(s0)") %>% - purrr::pluck(1) - - if (identical(quiet, FALSE)) { - rlang::inform(glue( - "tbl_survfit: Multi-state model detected. Showing probabilities into state '{state}'" - )) - } - tidy <- dplyr::filter(tidy, .data$state == .env$state) + state <- setdiff(unique(tidy$state), "(s0)")[[1]] + cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") + x <- dplyr::filter(x, .data$state == .env$state) } # tidy survfit results @@ -173,7 +166,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # convert estimates to requested type if (type != "survival") { df_stat <- df_stat %>% - dplyr::mutate(across( + dplyr::mutate(dplyr::across( any_of(c("estimate", "conf.low", "conf.high")), if (type == "cumhaz") ~ -log(.x) else ~ 1 - .x )) %>% @@ -233,7 +226,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% tidyr::pivot_longer( - cols = any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), + cols = dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), names_to = "stat_name", values_to = "stat" ) %>% diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index 70083d958..df09756ee 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -4,12 +4,7 @@ \alias{ard_survfit} \title{ARD Survival Estimates} \usage{ -ard_survfit( - x, - times = NULL, - probs = NULL, - type = c("survival", "risk", "cumhaz") -) +ard_survfit(x, times = NULL, probs = NULL, type = "survival") } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr From de5176a49ceae532784aac7d6d62a1f85d6e55c0 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 4 Mar 2024 20:17:28 -0500 Subject: [PATCH 19/34] Update suggests pkg checks, documentation --- NAMESPACE | 2 +- R/ard_survfit.R | 2 +- man/ard_hedges_g.Rd | 2 +- man/ard_survfit.Rd | 2 +- man/cardx-package.Rd | 4 ---- man/dot-format_cohens_d_results.Rd | 4 ---- man/dot-format_hedges_g_results.Rd | 4 ---- tests/testthat/test-ard_survfit.R | 2 ++ 8 files changed, 6 insertions(+), 16 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 7c60b84a4..c179c8272 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -18,8 +18,8 @@ export(ard_paired_wilcoxtest) export(ard_proportion_ci) export(ard_proptest) export(ard_regression) -export(ard_survfit) export(ard_regression_basic) +export(ard_survfit) export(ard_ttest) export(ard_wilcoxtest) export(contains) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index d2ff1fc85..58fff16bc 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -32,7 +32,7 @@ #' * Times should be provided using the same scale as the time variable used to fit the provided #' survival fit model. #' -#' @examplesIf broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE) +#' @examplesIf cards::is_pkg_installed("survival", reference_pkg = "cardx") #' library(survival) #' #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> diff --git a/man/ard_hedges_g.Rd b/man/ard_hedges_g.Rd index 97481a0ac..067b87c21 100644 --- a/man/ard_hedges_g.Rd +++ b/man/ard_hedges_g.Rd @@ -29,7 +29,7 @@ ARD data frame } \description{ Analysis results data for paired and non-paired Hedge's G Effect Size Test -using \code{\link[effectsize:cohens_d]{effectsize::hedges_g()}}. +using \code{\link[effectsize:hedges_g]{effectsize::hedges_g()}}. } \details{ For the \code{ard_hedges_g()} function, the data is expected to be one row per subject. diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index df09756ee..e077bebcb 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -41,7 +41,7 @@ survival fit model. } } \examples{ -\dontshow{if (broom.helpers::.assert_package("survival", pkg_search = "cardx", boolean = TRUE)) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (cards::is_pkg_installed("survival", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(survival) survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> diff --git a/man/cardx-package.Rd b/man/cardx-package.Rd index 4a96c86c0..b9ea7be11 100644 --- a/man/cardx-package.Rd +++ b/man/cardx-package.Rd @@ -24,10 +24,6 @@ Useful links: Authors: \itemize{ \item Abinaya Yogasekaram \email{abinaya.yogasekaram@contractors.roche.com} -} - -Authors: -\itemize{ \item Emily de la Rua \email{emily.de_la_rua@contractors.roche.com} } diff --git a/man/dot-format_cohens_d_results.Rd b/man/dot-format_cohens_d_results.Rd index 95cfc8b5c..5322ad66b 100644 --- a/man/dot-format_cohens_d_results.Rd +++ b/man/dot-format_cohens_d_results.Rd @@ -15,10 +15,6 @@ list of tidied results constructed with \code{\link[cards:eval_capture_conditions]{eval_capture_conditions()}}, e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}.} -\item{paired}{If \code{TRUE}, the values of \code{x} and \code{y} are considered as paired. -This produces an effect size that is equivalent to the one-sample effect -size on \code{x - y}.} - \item{...}{passed to \code{cohens_d(...)}} } \value{ diff --git a/man/dot-format_hedges_g_results.Rd b/man/dot-format_hedges_g_results.Rd index ba765e399..af8a478d0 100644 --- a/man/dot-format_hedges_g_results.Rd +++ b/man/dot-format_hedges_g_results.Rd @@ -15,10 +15,6 @@ list of tidied results constructed with \code{\link[cards:eval_capture_conditions]{eval_capture_conditions()}}, e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}.} -\item{paired}{If \code{TRUE}, the values of \code{x} and \code{y} are considered as paired. -This produces an effect size that is equivalent to the one-sample effect -size on \code{x - y}.} - \item{...}{passed to \code{hedges_g(...)}} } \value{ diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 2c6a31b4a..31164c0a7 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -1,3 +1,5 @@ +skip_if_not(cards::is_pkg_installed("survival", reference_pkg = "cardx")) + test_that("ard_survfit() works with times provided", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> From f979b3edf912f2ca9a50a708f6abc9fb7e69b703 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 4 Mar 2024 20:32:04 -0500 Subject: [PATCH 20/34] Fix docs --- inst/WORDLIST | 1 + man/ard_hedges_g.Rd | 2 +- man/dot-format_cohens_d_results.Rd | 4 ++++ man/dot-format_hedges_g_results.Rd | 4 ++++ 4 files changed, 10 insertions(+), 1 deletion(-) diff --git a/inst/WORDLIST b/inst/WORDLIST index e2d4bbd5b..5a18cb992 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -5,6 +5,7 @@ Clopper Codecov Hoffmann Jeffreys +Kaplan Lifecycle McNemar's Newcombe diff --git a/man/ard_hedges_g.Rd b/man/ard_hedges_g.Rd index 067b87c21..97481a0ac 100644 --- a/man/ard_hedges_g.Rd +++ b/man/ard_hedges_g.Rd @@ -29,7 +29,7 @@ ARD data frame } \description{ Analysis results data for paired and non-paired Hedge's G Effect Size Test -using \code{\link[effectsize:hedges_g]{effectsize::hedges_g()}}. +using \code{\link[effectsize:cohens_d]{effectsize::hedges_g()}}. } \details{ For the \code{ard_hedges_g()} function, the data is expected to be one row per subject. diff --git a/man/dot-format_cohens_d_results.Rd b/man/dot-format_cohens_d_results.Rd index 5322ad66b..95cfc8b5c 100644 --- a/man/dot-format_cohens_d_results.Rd +++ b/man/dot-format_cohens_d_results.Rd @@ -15,6 +15,10 @@ list of tidied results constructed with \code{\link[cards:eval_capture_conditions]{eval_capture_conditions()}}, e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}.} +\item{paired}{If \code{TRUE}, the values of \code{x} and \code{y} are considered as paired. +This produces an effect size that is equivalent to the one-sample effect +size on \code{x - y}.} + \item{...}{passed to \code{cohens_d(...)}} } \value{ diff --git a/man/dot-format_hedges_g_results.Rd b/man/dot-format_hedges_g_results.Rd index af8a478d0..ba765e399 100644 --- a/man/dot-format_hedges_g_results.Rd +++ b/man/dot-format_hedges_g_results.Rd @@ -15,6 +15,10 @@ list of tidied results constructed with \code{\link[cards:eval_capture_conditions]{eval_capture_conditions()}}, e.g. \code{eval_capture_conditions(t.test(mtcars$mpg ~ mtcars$am) |> broom::tidy())}.} +\item{paired}{If \code{TRUE}, the values of \code{x} and \code{y} are considered as paired. +This produces an effect size that is equivalent to the one-sample effect +size on \code{x - y}.} + \item{...}{passed to \code{hedges_g(...)}} } \value{ From 9db0d412b827a40d549b8db3b5881fa30584f782 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 4 Mar 2024 20:44:31 -0500 Subject: [PATCH 21/34] Typo --- R/ard_survfit.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 58fff16bc..283b68c6b 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -96,7 +96,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { multi_state <- inherits(x, "survfitms") if (multi_state == TRUE) { # selecting state to show - state <- setdiff(unique(tidy$state), "(s0)")[[1]] + state <- setdiff(unique(x$state), "(s0)")[[1]] cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") x <- dplyr::filter(x, .data$state == .env$state) } From 1cc184df30f2f9197a0f8a8f1b9b6e18f91b6e44 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 5 Mar 2024 11:11:48 -0500 Subject: [PATCH 22/34] Add example, test --- R/ard_survfit.R | 29 +++++++++---- man/ard_survfit.Rd | 16 ++++++- tests/testthat/_snaps/ard_survfit.md | 62 ++++++++++++++++++++++++++++ tests/testthat/test-ard_survfit.R | 23 ++++++++++- 4 files changed, 121 insertions(+), 9 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 283b68c6b..9ee48edf0 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -32,7 +32,7 @@ #' * Times should be provided using the same scale as the time variable used to fit the provided #' survival fit model. #' -#' @examplesIf cards::is_pkg_installed("survival", reference_pkg = "cardx") +#' @examplesIf cards::is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") #' library(survival) #' #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> @@ -40,13 +40,27 @@ #' #' survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> #' ard_survfit(probs = c(0.25, 0.5, 0.75)) +#' +#' # Competing Risks Example --------------------------- +#' set.seed(1) +#' ADTTE_MS <- cards::ADTTE %>% +#' dplyr::mutate( +#' CNSR = dplyr::case_when( +#' CNSR == 0 ~ "censor", +#' runif(dplyr::n()) < 0.5 ~ "death from cancer", +#' TRUE ~ "death other causes" +#' ) %>% factor() +#' ) +#' +#' survfit(Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% +#' ard_survfit(times = c(60, 180)) NULL #' @rdname ard_survfit #' @export ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # check installed packages --------------------------------------------------- - cards::check_pkg_installed("survival", reference_pkg = "cardx") + cards::check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(x) @@ -92,18 +106,19 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { #' #' @keywords internal .process_survfit_time <- function(x, times, type) { + # tidy survfit results + tidy_x <- broom::tidy(x) + # process multi-state models multi_state <- inherits(x, "survfitms") + if (multi_state == TRUE) { # selecting state to show - state <- setdiff(unique(x$state), "(s0)")[[1]] + state <- setdiff(unique(tidy_x$state), "(s0)")[[1]] cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") - x <- dplyr::filter(x, .data$state == .env$state) + x <- dplyr::filter(tidy_x, .data$state == .env$state) } - # tidy survfit results - tidy_x <- broom::tidy(x) - # adding time 0 to data frame tidy_x <- tidy_x %>% # make strata a fct to preserve ordering diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index e077bebcb..414e16df1 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -41,7 +41,7 @@ survival fit model. } } \examples{ -\dontshow{if (cards::is_pkg_installed("survival", reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (cards::is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} library(survival) survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> @@ -49,5 +49,19 @@ survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> survfit(Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> ard_survfit(probs = c(0.25, 0.5, 0.75)) + +# Competing Risks Example --------------------------- +set.seed(1) +ADTTE_MS <- cards::ADTTE \%>\% + dplyr::mutate( + CNSR = dplyr::case_when( + CNSR == 0 ~ "censor", + runif(dplyr::n()) < 0.5 ~ "death from cancer", + TRUE ~ "death other causes" + ) \%>\% factor() + ) + +survfit(Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) \%>\% + ard_survfit(times = c(60, 180)) \dontshow{\}) # examplesIf} } diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 958310056..6105c99e3 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -110,6 +110,68 @@ Message i 1 more variable: fmt_fn +# ard_survfit() works with competing risks + + Code + print(dplyr::mutate(survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% + ard_survfit(times = c(60, 180)), stat = lapply(stat, function(x) ifelse( + is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + Multi-state model detected. Showing probabilities into state 'death from cancer'. + {cards} data frame: 48 x 7 + Output + variable variable_level context stat_name stat_label stat + 1 TRTA Placebo survival estimate Survival… 0.053 + 2 TRTA Placebo survival conf.high CI Upper… 0.139 + 3 TRTA Placebo survival conf.low CI Lower… 0.021 + 4 TRTA Placebo survival time Time 60 + 5 TRTA Placebo survival estimate Survival… 0.123 + 6 TRTA Placebo survival conf.high CI Upper… 0.237 + 7 TRTA Placebo survival conf.low CI Lower… 0.064 + 8 TRTA Placebo survival time Time 180 + 9 TRTA Xanomeli… survival estimate Survival… 0.169 + 10 TRTA Xanomeli… survival conf.high CI Upper… 0.304 + 11 TRTA Xanomeli… survival conf.low CI Lower… 0.094 + 12 TRTA Xanomeli… survival time Time 60 + 13 TRTA Xanomeli… survival estimate Survival… 0.262 + 14 TRTA Xanomeli… survival conf.high CI Upper… 0.749 + 15 TRTA Xanomeli… survival conf.low CI Lower… 0.092 + 16 TRTA Xanomeli… survival time Time 180 + 17 TRTA Xanomeli… survival estimate Survival… 0.51 + 18 TRTA Xanomeli… survival conf.high CI Upper… 0.892 + 19 TRTA Xanomeli… survival conf.low CI Lower… 0.292 + 20 TRTA Xanomeli… survival time Time 180 + 21 TRTA Xanomeli… survival estimate Survival… 0.228 + 22 TRTA Xanomeli… survival conf.high CI Upper… 0.427 + 23 TRTA Xanomeli… survival conf.low CI Lower… 0.121 + 24 TRTA Xanomeli… survival time Time 180 + 25 TRTA Xanomeli… survival estimate Survival… 0.732 + 26 TRTA Xanomeli… survival conf.high CI Upper… 0.878 + 27 TRTA Xanomeli… survival conf.low CI Lower… 0.61 + 28 TRTA Xanomeli… survival time Time 60 + 29 TRTA Xanomeli… survival estimate Survival… 0.162 + 30 TRTA Xanomeli… survival conf.high CI Upper… 0.33 + 31 TRTA Xanomeli… survival conf.low CI Lower… 0.08 + 32 TRTA Xanomeli… survival time Time 60 + 33 TRTA Xanomeli… survival estimate Survival… 0.106 + 34 TRTA Xanomeli… survival conf.high CI Upper… 0.232 + 35 TRTA Xanomeli… survival conf.low CI Lower… 0.048 + 36 TRTA Xanomeli… survival time Time 60 + 37 TRTA Xanomeli… survival estimate Survival… 0.381 + 38 TRTA Xanomeli… survival conf.high CI Upper… 0.743 + 39 TRTA Xanomeli… survival conf.low CI Lower… 0.195 + 40 TRTA Xanomeli… survival time Time 180 + 41 TRTA Xanomeli… survival estimate Survival… 0.244 + 42 TRTA Xanomeli… survival conf.high CI Upper… 0.516 + 43 TRTA Xanomeli… survival conf.low CI Lower… 0.115 + 44 TRTA Xanomeli… survival time Time 180 + 45 TRTA Xanomeli… survival estimate Survival… 0.375 + 46 TRTA Xanomeli… survival conf.high CI Upper… 0.719 + 47 TRTA Xanomeli… survival conf.low CI Lower… 0.196 + 48 TRTA Xanomeli… survival time Time 180 + Message + i 1 more variable: fmt_fn + # ard_survfit() errors are properly handled Code diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 31164c0a7..73be463aa 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -1,4 +1,4 @@ -skip_if_not(cards::is_pkg_installed("survival", reference_pkg = "cardx")) +skip_if_not(cards::is_pkg_installed(c("survival", "broom"), reference_pkg = "cardx")) test_that("ard_survfit() works with times provided", { expect_snapshot( @@ -33,6 +33,27 @@ test_that("ard_survfit() works with probs provided", { ) }) +test_that("ard_survfit() works with competing risks", { + set.seed(1) + ADTTE_MS <- cards::ADTTE %>% + dplyr::mutate( + CNSR = dplyr::case_when( + CNSR == 0 ~ "censor", + runif(dplyr::n()) < 0.5 ~ "death from cancer", + TRUE ~ "death other causes" + ) %>% factor() + ) + + expect_snapshot( + survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + test_that("ard_survfit() errors are properly handled", { expect_snapshot( ard_survfit("not_survfit"), From ddd39c437ce47e50fe3436104a6a6325b25d8170 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 5 Mar 2024 11:31:24 -0500 Subject: [PATCH 23/34] Styler, typo --- R/ard_survfit.R | 2 +- tests/testthat/_snaps/ard_survfit.md | 62 +++++++++------------------- tests/testthat/test-ard_survfit.R | 2 +- 3 files changed, 21 insertions(+), 45 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 9ee48edf0..dc71dd46e 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -116,7 +116,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # selecting state to show state <- setdiff(unique(tidy_x$state), "(s0)")[[1]] cli::cli_inform("Multi-state model detected. Showing probabilities into state '{state}'.") - x <- dplyr::filter(tidy_x, .data$state == .env$state) + tidy_x <- dplyr::filter(tidy_x, .data$state == .env$state) } # adding time 0 to data frame diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 6105c99e3..868c5f76b 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -118,57 +118,33 @@ is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message Multi-state model detected. Showing probabilities into state 'death from cancer'. - {cards} data frame: 48 x 7 + {cards} data frame: 24 x 7 Output variable variable_level context stat_name stat_label stat - 1 TRTA Placebo survival estimate Survival… 0.053 - 2 TRTA Placebo survival conf.high CI Upper… 0.139 + 1 TRTA Placebo survival estimate Survival… 0.054 + 2 TRTA Placebo survival conf.high CI Upper… 0.14 3 TRTA Placebo survival conf.low CI Lower… 0.021 4 TRTA Placebo survival time Time 60 - 5 TRTA Placebo survival estimate Survival… 0.123 - 6 TRTA Placebo survival conf.high CI Upper… 0.237 - 7 TRTA Placebo survival conf.low CI Lower… 0.064 + 5 TRTA Placebo survival estimate Survival… 0.226 + 6 TRTA Placebo survival conf.high CI Upper… 0.361 + 7 TRTA Placebo survival conf.low CI Lower… 0.142 8 TRTA Placebo survival time Time 180 - 9 TRTA Xanomeli… survival estimate Survival… 0.169 - 10 TRTA Xanomeli… survival conf.high CI Upper… 0.304 - 11 TRTA Xanomeli… survival conf.low CI Lower… 0.094 + 9 TRTA Xanomeli… survival estimate Survival… 0.137 + 10 TRTA Xanomeli… survival conf.high CI Upper… 0.311 + 11 TRTA Xanomeli… survival conf.low CI Lower… 0.06 12 TRTA Xanomeli… survival time Time 60 - 13 TRTA Xanomeli… survival estimate Survival… 0.262 - 14 TRTA Xanomeli… survival conf.high CI Upper… 0.749 - 15 TRTA Xanomeli… survival conf.low CI Lower… 0.092 + 13 TRTA Xanomeli… survival estimate Survival… 0.51 + 14 TRTA Xanomeli… survival conf.high CI Upper… 0.892 + 15 TRTA Xanomeli… survival conf.low CI Lower… 0.292 16 TRTA Xanomeli… survival time Time 180 - 17 TRTA Xanomeli… survival estimate Survival… 0.51 - 18 TRTA Xanomeli… survival conf.high CI Upper… 0.892 - 19 TRTA Xanomeli… survival conf.low CI Lower… 0.292 - 20 TRTA Xanomeli… survival time Time 180 - 21 TRTA Xanomeli… survival estimate Survival… 0.228 - 22 TRTA Xanomeli… survival conf.high CI Upper… 0.427 - 23 TRTA Xanomeli… survival conf.low CI Lower… 0.121 + 17 TRTA Xanomeli… survival estimate Survival… 0.162 + 18 TRTA Xanomeli… survival conf.high CI Upper… 0.33 + 19 TRTA Xanomeli… survival conf.low CI Lower… 0.08 + 20 TRTA Xanomeli… survival time Time 60 + 21 TRTA Xanomeli… survival estimate Survival… 0.244 + 22 TRTA Xanomeli… survival conf.high CI Upper… 0.516 + 23 TRTA Xanomeli… survival conf.low CI Lower… 0.115 24 TRTA Xanomeli… survival time Time 180 - 25 TRTA Xanomeli… survival estimate Survival… 0.732 - 26 TRTA Xanomeli… survival conf.high CI Upper… 0.878 - 27 TRTA Xanomeli… survival conf.low CI Lower… 0.61 - 28 TRTA Xanomeli… survival time Time 60 - 29 TRTA Xanomeli… survival estimate Survival… 0.162 - 30 TRTA Xanomeli… survival conf.high CI Upper… 0.33 - 31 TRTA Xanomeli… survival conf.low CI Lower… 0.08 - 32 TRTA Xanomeli… survival time Time 60 - 33 TRTA Xanomeli… survival estimate Survival… 0.106 - 34 TRTA Xanomeli… survival conf.high CI Upper… 0.232 - 35 TRTA Xanomeli… survival conf.low CI Lower… 0.048 - 36 TRTA Xanomeli… survival time Time 60 - 37 TRTA Xanomeli… survival estimate Survival… 0.381 - 38 TRTA Xanomeli… survival conf.high CI Upper… 0.743 - 39 TRTA Xanomeli… survival conf.low CI Lower… 0.195 - 40 TRTA Xanomeli… survival time Time 180 - 41 TRTA Xanomeli… survival estimate Survival… 0.244 - 42 TRTA Xanomeli… survival conf.high CI Upper… 0.516 - 43 TRTA Xanomeli… survival conf.low CI Lower… 0.115 - 44 TRTA Xanomeli… survival time Time 180 - 45 TRTA Xanomeli… survival estimate Survival… 0.375 - 46 TRTA Xanomeli… survival conf.high CI Upper… 0.719 - 47 TRTA Xanomeli… survival conf.low CI Lower… 0.196 - 48 TRTA Xanomeli… survival time Time 180 Message i 1 more variable: fmt_fn diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 73be463aa..074b67cd7 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -46,7 +46,7 @@ test_that("ard_survfit() works with competing risks", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, data = ADTTE_MS) %>% - ard_survfit(times = c(60, 180)) |> + ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> From a0d2debad1f1a250f3b9f9e5149855d23e7f624c Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Fri, 15 Mar 2024 18:51:51 -0400 Subject: [PATCH 24/34] move strata to group variables --- R/ard_survfit.R | 13 +- tests/testthat/_snaps/ard_survfit.md | 192 ++++++++++++--------------- 2 files changed, 94 insertions(+), 111 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index dc71dd46e..57838b514 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -109,7 +109,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # tidy survfit results tidy_x <- broom::tidy(x) - # process multi-state models + # process competing risks/multi-state models multi_state <- inherits(x, "survfitms") if (multi_state == TRUE) { @@ -236,16 +236,23 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { #' #' @keywords internal .format_survfit_results <- function(tidy_survfit) { + type <- if ("time" %in% names(tidy_survfit)) "time" else "prob" + ret <- tidy_survfit %>% dplyr::mutate(dplyr::across( dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), ~ as.list(.) )) %>% tidyr::pivot_longer( - cols = dplyr::any_of(c("estimate", "conf.high", "conf.low", "time", "prob")), + cols = dplyr::any_of(c("estimate", "conf.high", "conf.low")), names_to = "stat_name", values_to = "stat" ) %>% - tidyr::separate_wider_delim("strata", "=", names = c("variable", "variable_level")) + tidyr::separate_wider_delim("strata", "=", names = c("group1", "group1_level")) %>% + dplyr::mutate( + variable = type, + variable_level = .data[[type]] + ) %>% + dplyr::select(-all_of(type)) ret %>% dplyr::left_join( diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 868c5f76b..a48b92d84 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -5,35 +5,29 @@ TRTA, cards::ADTTE), times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 24 x 7 + {cards} data frame: 18 x 9 Output - variable variable_level context stat_name stat_label stat - 1 TRTA Placebo survival estimate Survival… 0.893 - 2 TRTA Placebo survival conf.high CI Upper… 0.966 - 3 TRTA Placebo survival conf.low CI Lower… 0.825 - 4 TRTA Placebo survival time Time 60 - 5 TRTA Placebo survival estimate Survival… 0.651 - 6 TRTA Placebo survival conf.high CI Upper… 0.783 - 7 TRTA Placebo survival conf.low CI Lower… 0.541 - 8 TRTA Placebo survival time Time 180 - 9 TRTA Xanomeli… survival estimate Survival… 0.694 - 10 TRTA Xanomeli… survival conf.high CI Upper… 0.849 - 11 TRTA Xanomeli… survival conf.low CI Lower… 0.568 - 12 TRTA Xanomeli… survival time Time 60 - 13 TRTA Xanomeli… survival estimate Survival… 0.262 - 14 TRTA Xanomeli… survival conf.high CI Upper… 0.749 - 15 TRTA Xanomeli… survival conf.low CI Lower… 0.092 - 16 TRTA Xanomeli… survival time Time 180 - 17 TRTA Xanomeli… survival estimate Survival… 0.732 - 18 TRTA Xanomeli… survival conf.high CI Upper… 0.878 - 19 TRTA Xanomeli… survival conf.low CI Lower… 0.61 - 20 TRTA Xanomeli… survival time Time 60 - 21 TRTA Xanomeli… survival estimate Survival… 0.381 - 22 TRTA Xanomeli… survival conf.high CI Upper… 0.743 - 23 TRTA Xanomeli… survival conf.low CI Lower… 0.195 - 24 TRTA Xanomeli… survival time Time 180 + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.893 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.966 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.825 + 4 TRTA Placebo time 180 estimate Survival… 0.651 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.783 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.541 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.694 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.849 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.568 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.262 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.749 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.092 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.732 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.878 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.61 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.381 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.743 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.195 Message - i 1 more variable: fmt_fn + i 2 more variables: context, fmt_fn # ard_survfit() works with different type @@ -42,35 +36,29 @@ TRTA, cards::ADTTE), times = c(60, 180), type = "risk"), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 24 x 7 + {cards} data frame: 18 x 9 Output - variable variable_level context stat_name stat_label stat - 1 TRTA Placebo risk estimate Survival… 0.107 - 2 TRTA Placebo risk conf.high CI Upper… 0.175 - 3 TRTA Placebo risk conf.low CI Lower… 0.034 - 4 TRTA Placebo risk time Time 60 - 5 TRTA Placebo risk estimate Survival… 0.349 - 6 TRTA Placebo risk conf.high CI Upper… 0.459 - 7 TRTA Placebo risk conf.low CI Lower… 0.217 - 8 TRTA Placebo risk time Time 180 - 9 TRTA Xanomeli… risk estimate Survival… 0.306 - 10 TRTA Xanomeli… risk conf.high CI Upper… 0.432 - 11 TRTA Xanomeli… risk conf.low CI Lower… 0.151 - 12 TRTA Xanomeli… risk time Time 60 - 13 TRTA Xanomeli… risk estimate Survival… 0.738 - 14 TRTA Xanomeli… risk conf.high CI Upper… 0.908 - 15 TRTA Xanomeli… risk conf.low CI Lower… 0.251 - 16 TRTA Xanomeli… risk time Time 180 - 17 TRTA Xanomeli… risk estimate Survival… 0.268 - 18 TRTA Xanomeli… risk conf.high CI Upper… 0.39 - 19 TRTA Xanomeli… risk conf.low CI Lower… 0.122 - 20 TRTA Xanomeli… risk time Time 60 - 21 TRTA Xanomeli… risk estimate Survival… 0.619 - 22 TRTA Xanomeli… risk conf.high CI Upper… 0.805 - 23 TRTA Xanomeli… risk conf.low CI Lower… 0.257 - 24 TRTA Xanomeli… risk time Time 180 + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.107 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.175 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.034 + 4 TRTA Placebo time 180 estimate Survival… 0.349 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.459 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.217 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.306 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.432 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.151 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.738 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.908 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.251 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.268 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.39 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.122 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.619 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.805 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.257 Message - i 1 more variable: fmt_fn + i 2 more variables: context, fmt_fn # ard_survfit() works with probs provided @@ -80,35 +68,29 @@ stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message The `type` argument is ignored for survival quantile estimation. - {cards} data frame: 24 x 7 + {cards} data frame: 18 x 9 Output - variable variable_level context stat_name stat_label stat - 1 TRTA Placebo survival estimate Survival… 142 - 2 TRTA Placebo survival conf.high CI Upper… 181 - 3 TRTA Placebo survival conf.low CI Lower… 70 - 4 TRTA Placebo survival prob Quantile 0.25 - 5 TRTA Xanomeli… survival estimate Survival… 44 - 6 TRTA Xanomeli… survival conf.high CI Upper… 180 - 7 TRTA Xanomeli… survival conf.low CI Lower… 22 - 8 TRTA Xanomeli… survival prob Quantile 0.25 - 9 TRTA Xanomeli… survival estimate Survival… 49 - 10 TRTA Xanomeli… survival conf.high CI Upper… 180 - 11 TRTA Xanomeli… survival conf.low CI Lower… 37 - 12 TRTA Xanomeli… survival prob Quantile 0.25 - 13 TRTA Placebo survival estimate Survival… 184 - 14 TRTA Placebo survival conf.high CI Upper… 191 - 15 TRTA Placebo survival conf.low CI Lower… 183 - 16 TRTA Placebo survival prob Quantile 0.75 - 17 TRTA Xanomeli… survival estimate Survival… 188 - 18 TRTA Xanomeli… survival conf.high CI Upper… NA - 19 TRTA Xanomeli… survival conf.low CI Lower… 167 - 20 TRTA Xanomeli… survival prob Quantile 0.75 - 21 TRTA Xanomeli… survival estimate Survival… 184 - 22 TRTA Xanomeli… survival conf.high CI Upper… NA - 23 TRTA Xanomeli… survival conf.low CI Lower… 180 - 24 TRTA Xanomeli… survival prob Quantile 0.75 + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo prob 0.25 estimate Survival… 142 + 2 TRTA Placebo prob 0.25 conf.high CI Upper… 181 + 3 TRTA Placebo prob 0.25 conf.low CI Lower… 70 + 4 TRTA Placebo prob 0.75 estimate Survival… 184 + 5 TRTA Placebo prob 0.75 conf.high CI Upper… 191 + 6 TRTA Placebo prob 0.75 conf.low CI Lower… 183 + 7 TRTA Xanomeli… prob 0.25 estimate Survival… 44 + 8 TRTA Xanomeli… prob 0.25 conf.high CI Upper… 180 + 9 TRTA Xanomeli… prob 0.25 conf.low CI Lower… 22 + 10 TRTA Xanomeli… prob 0.75 estimate Survival… 188 + 11 TRTA Xanomeli… prob 0.75 conf.high CI Upper… NA + 12 TRTA Xanomeli… prob 0.75 conf.low CI Lower… 167 + 13 TRTA Xanomeli… prob 0.25 estimate Survival… 49 + 14 TRTA Xanomeli… prob 0.25 conf.high CI Upper… 180 + 15 TRTA Xanomeli… prob 0.25 conf.low CI Lower… 37 + 16 TRTA Xanomeli… prob 0.75 estimate Survival… 184 + 17 TRTA Xanomeli… prob 0.75 conf.high CI Upper… NA + 18 TRTA Xanomeli… prob 0.75 conf.low CI Lower… 180 Message - i 1 more variable: fmt_fn + i 2 more variables: context, fmt_fn # ard_survfit() works with competing risks @@ -118,35 +100,29 @@ is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message Multi-state model detected. Showing probabilities into state 'death from cancer'. - {cards} data frame: 24 x 7 + {cards} data frame: 18 x 9 Output - variable variable_level context stat_name stat_label stat - 1 TRTA Placebo survival estimate Survival… 0.054 - 2 TRTA Placebo survival conf.high CI Upper… 0.14 - 3 TRTA Placebo survival conf.low CI Lower… 0.021 - 4 TRTA Placebo survival time Time 60 - 5 TRTA Placebo survival estimate Survival… 0.226 - 6 TRTA Placebo survival conf.high CI Upper… 0.361 - 7 TRTA Placebo survival conf.low CI Lower… 0.142 - 8 TRTA Placebo survival time Time 180 - 9 TRTA Xanomeli… survival estimate Survival… 0.137 - 10 TRTA Xanomeli… survival conf.high CI Upper… 0.311 - 11 TRTA Xanomeli… survival conf.low CI Lower… 0.06 - 12 TRTA Xanomeli… survival time Time 60 - 13 TRTA Xanomeli… survival estimate Survival… 0.51 - 14 TRTA Xanomeli… survival conf.high CI Upper… 0.892 - 15 TRTA Xanomeli… survival conf.low CI Lower… 0.292 - 16 TRTA Xanomeli… survival time Time 180 - 17 TRTA Xanomeli… survival estimate Survival… 0.162 - 18 TRTA Xanomeli… survival conf.high CI Upper… 0.33 - 19 TRTA Xanomeli… survival conf.low CI Lower… 0.08 - 20 TRTA Xanomeli… survival time Time 60 - 21 TRTA Xanomeli… survival estimate Survival… 0.244 - 22 TRTA Xanomeli… survival conf.high CI Upper… 0.516 - 23 TRTA Xanomeli… survival conf.low CI Lower… 0.115 - 24 TRTA Xanomeli… survival time Time 180 + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo time 60 estimate Survival… 0.054 + 2 TRTA Placebo time 60 conf.high CI Upper… 0.14 + 3 TRTA Placebo time 60 conf.low CI Lower… 0.021 + 4 TRTA Placebo time 180 estimate Survival… 0.226 + 5 TRTA Placebo time 180 conf.high CI Upper… 0.361 + 6 TRTA Placebo time 180 conf.low CI Lower… 0.142 + 7 TRTA Xanomeli… time 60 estimate Survival… 0.137 + 8 TRTA Xanomeli… time 60 conf.high CI Upper… 0.311 + 9 TRTA Xanomeli… time 60 conf.low CI Lower… 0.06 + 10 TRTA Xanomeli… time 180 estimate Survival… 0.51 + 11 TRTA Xanomeli… time 180 conf.high CI Upper… 0.892 + 12 TRTA Xanomeli… time 180 conf.low CI Lower… 0.292 + 13 TRTA Xanomeli… time 60 estimate Survival… 0.162 + 14 TRTA Xanomeli… time 60 conf.high CI Upper… 0.33 + 15 TRTA Xanomeli… time 60 conf.low CI Lower… 0.08 + 16 TRTA Xanomeli… time 180 estimate Survival… 0.244 + 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.516 + 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.115 Message - i 1 more variable: fmt_fn + i 2 more variables: context, fmt_fn # ard_survfit() errors are properly handled From 112127e7afa1f31c5b6a33c026473e39d7d3b7f4 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Mon, 18 Mar 2024 16:29:29 -0400 Subject: [PATCH 25/34] Allow unstratified --- R/ard_survfit.R | 42 ++++++++++++++++++---------- tests/testthat/_snaps/ard_survfit.md | 38 +++++++++++++++++++++++++ tests/testthat/test-ard_survfit.R | 20 +++++++++++++ 3 files changed, 86 insertions(+), 14 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 57838b514..ff3653137 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -122,7 +122,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # adding time 0 to data frame tidy_x <- tidy_x %>% # make strata a fct to preserve ordering - dplyr::mutate_at("strata", ~ factor(., levels = unique(.))) %>% + dplyr::mutate(dplyr::across(dplyr::any_of("strata"), ~ factor(., levels = unique(.)))) %>% # if CI is missing and SE is 0, use estimate as the CI dplyr::mutate_at( dplyr::vars("conf.high", "conf.low"), @@ -131,7 +131,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { dplyr::select(dplyr::any_of(c("time", "estimate", "conf.high", "conf.low", "strata"))) %>% # add data for time 0 dplyr::bind_rows( - dplyr::group_by(., .data$strata) %>% + dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% dplyr::slice(1) %>% dplyr::mutate( time = 0, @@ -142,27 +142,35 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { ) %>% dplyr::ungroup() + strat <- "strata" %in% names(tidy_x) + # get requested estimates df_stat <- tidy_x %>% # find max time - dplyr::group_by(., .data$strata) %>% + dplyr::group_by_at(., dplyr::vars(dplyr::any_of("strata"))) %>% dplyr::mutate(time_max = max(.data$time)) %>% dplyr::ungroup() %>% # add requested timepoints dplyr::full_join( tidy_x %>% - dplyr::select("strata") %>% + dplyr::select(any_of("strata")) %>% dplyr::distinct() %>% dplyr::mutate( time = list(.env$times), col_name = list(paste("stat", seq_len(length(.env$times)), sep = "_")) ) %>% tidyr::unnest(cols = c("time", "col_name")), - by = unlist(c("strata", "time")) - ) %>% + by = unlist(intersect(c("strata", "time"), names(tidy_x))) + ) + + if (strat) { + df_stat <- df_stat %>% dplyr::arrange(.data$strata) + } + + df_stat <- df_stat %>% # if user-specifed time is unobserved, fill estimate with previous value - dplyr::arrange(.data$strata, .data$time) %>% - dplyr::group_by(.data$strata) %>% + dplyr::arrange(.data$time) %>% + dplyr::group_by_at(dplyr::vars(dplyr::any_of("strata"))) %>% tidyr::fill( "estimate", "conf.high", "conf.low", "time_max", .direction = "down" @@ -212,7 +220,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { as.data.frame() %>% set_names(c("estimate", "conf.low", "conf.high")) %>% dplyr::mutate(strata = row.names(.)) %>% - dplyr::select(strata, estimate, conf.low, conf.high) %>% + dplyr::select(dplyr::any_of(c("strata", "estimate", "conf.low", "conf.high"))) %>% dplyr::mutate(prob = .x) ) %>% dplyr::bind_rows() %>% @@ -220,6 +228,8 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { dplyr::mutate(context = "survival") %>% dplyr::as_tibble() + if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-strata) + df_stat } @@ -236,7 +246,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { #' #' @keywords internal .format_survfit_results <- function(tidy_survfit) { - type <- if ("time" %in% names(tidy_survfit)) "time" else "prob" + est <- if ("time" %in% names(tidy_survfit)) "time" else "prob" ret <- tidy_survfit %>% dplyr::mutate(dplyr::across( @@ -247,12 +257,16 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { names_to = "stat_name", values_to = "stat" ) %>% - tidyr::separate_wider_delim("strata", "=", names = c("group1", "group1_level")) %>% dplyr::mutate( - variable = type, - variable_level = .data[[type]] + variable = est, + variable_level = .data[[est]] ) %>% - dplyr::select(-all_of(type)) + dplyr::select(-all_of(est)) + + if ("strata" %in% names(ret)) { + ret <- ret %>% + tidyr::separate_wider_delim("strata", "=", names = c("group1", "group1_level")) + } ret %>% dplyr::left_join( diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index a48b92d84..983b1c4c3 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -92,6 +92,44 @@ Message i 2 more variables: context, fmt_fn +# ard_survfit() works with unstratified model + + Code + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ + 1, data = lung), times = c(60, 180)), stat = lapply(stat, function(x) ifelse( + is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 6 x 7 + Output + variable variable_level context stat_name stat_label stat + 1 time 60 survival estimate Survival… 0.925 + 2 time 60 survival conf.high CI Upper… 0.96 + 3 time 60 survival conf.low CI Lower… 0.892 + 4 time 180 survival estimate Survival… 0.722 + 5 time 180 survival conf.high CI Upper… 0.783 + 6 time 180 survival conf.low CI Lower… 0.666 + Message + i 1 more variable: fmt_fn + +--- + + Code + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ + 1, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, function(x) + ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 6 x 7 + Output + variable variable_level context stat_name stat_label stat + 1 prob 0.5 survival estimate Survival… 310 + 2 prob 0.5 survival conf.high CI Upper… 363 + 3 prob 0.5 survival conf.low CI Lower… 285 + 4 prob 0.75 survival estimate Survival… 550 + 5 prob 0.75 survival conf.high CI Upper… 654 + 6 prob 0.75 survival conf.low CI Lower… 460 + Message + i 1 more variable: fmt_fn + # ard_survfit() works with competing risks Code diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 074b67cd7..1df2232aa 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -33,6 +33,26 @@ test_that("ard_survfit() works with probs provided", { ) }) +test_that("ard_survfit() works with unstratified model", { + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ 1, data = lung) |> + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) + + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ 1, data = lung) |> + ard_survfit(probs = c(0.5, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + test_that("ard_survfit() works with competing risks", { set.seed(1) ADTTE_MS <- cards::ADTTE %>% From cc874393e7e96113550a947a19aefecbdfd1e4ca Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 19 Mar 2024 15:42:15 -0400 Subject: [PATCH 26/34] Process multiple strata --- R/ard_survfit.R | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index ff3653137..e86a46e5b 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -196,6 +196,8 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { dplyr::rename(conf.low = "conf.high", conf.high = "conf.low") } + df_stat <- extract_multi_strata(x, df_stat) + df_stat } @@ -230,6 +232,31 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-strata) + df_stat <- extract_multi_strata(x, df_stat) + + df_stat +} + +# process multiple stratifying variables +extract_multi_strata <- function(x, df_stat) { + x_terms <- attr(terms(as.formula(x$call$formula)), "term.labels") + if (length(x_terms) > 1) { + strata_lvls <- data.frame() + + for (i in df_stat$strata) { + terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[1]] + s_lvl <- terms_str[nchar(terms_str) > 0] + strata_lvls <- rbind(strata_lvls, s_lvl) + } + if (nrow(strata_lvls) > 0) { + strata_lvls <- cbind(strata_lvls, t(x_terms)) + names(strata_lvls) <- c( + t(sapply(seq_along(x_terms), function(i) c(paste0("group", i, "_level"), paste0("group", i)))) + ) + df_stat <- cbind(df_stat, strata_lvls) %>% + dplyr::select(-strata) + } + } df_stat } From 105dcc69210adb924af0078e8ffc8237a0668d9a Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 19 Mar 2024 15:47:49 -0400 Subject: [PATCH 27/34] Fix roxygen --- R/ard_svycontinuous.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/ard_svycontinuous.R b/R/ard_svycontinuous.R index cb719d27b..762069cbe 100644 --- a/R/ard_svycontinuous.R +++ b/R/ard_svycontinuous.R @@ -27,7 +27,7 @@ #' @section statistic argument: #' #' The following statistics are available: -#' `r cardx:::accepted_svy_stats(FALSE) |> shQuote() |> paste(collapse = ", ")`, +#' `r cardx:::accepted_svy_stats(FALSE) |> shQuote("sh") |> paste(collapse = ", ")`, #' where 'p##' is are the percentiles and `##` is an integer between 0 and 100. #' #' From 1ac89c9de6fb6f4c4bb2934813ac1caa4966b017 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Tue, 19 Mar 2024 15:54:50 -0400 Subject: [PATCH 28/34] Add tests --- tests/testthat/_snaps/ard_survfit.md | 196 +++++++++++++++++++++++++++ tests/testthat/test-ard_survfit.R | 20 +++ 2 files changed, 216 insertions(+) diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 983b1c4c3..8549f7e97 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -130,6 +130,202 @@ Message i 1 more variable: fmt_fn +# ard_survfit() works with multiple stratification variables + + Code + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ + sex + ph.ecog, data = lung), times = c(60, 180)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 42 x 11 + Output + group1 group1_level group2 group2_level variable variable_level stat_name + 1 sex 1 ph.ecog 0 time 60 estimate + 2 sex 1 ph.ecog 0 time 60 conf.high + 3 sex 1 ph.ecog 0 time 60 conf.low + 4 sex 1 ph.ecog 0 time 180 estimate + 5 sex 1 ph.ecog 0 time 180 conf.high + 6 sex 1 ph.ecog 0 time 180 conf.low + 7 sex 1 ph.ecog 1 time 60 estimate + 8 sex 1 ph.ecog 1 time 60 conf.high + 9 sex 1 ph.ecog 1 time 60 conf.low + 10 sex 1 ph.ecog 1 time 180 estimate + 11 sex 1 ph.ecog 1 time 180 conf.high + 12 sex 1 ph.ecog 1 time 180 conf.low + 13 sex 1 ph.ecog 2 time 60 estimate + 14 sex 1 ph.ecog 2 time 60 conf.high + 15 sex 1 ph.ecog 2 time 60 conf.low + 16 sex 1 ph.ecog 2 time 180 estimate + 17 sex 1 ph.ecog 2 time 180 conf.high + 18 sex 1 ph.ecog 2 time 180 conf.low + 19 sex 1 ph.ecog 3 time 60 estimate + 20 sex 1 ph.ecog 3 time 60 conf.high + 21 sex 1 ph.ecog 3 time 60 conf.low + 22 sex 1 ph.ecog 3 time 180 estimate + 23 sex 1 ph.ecog 3 time 180 conf.high + 24 sex 1 ph.ecog 3 time 180 conf.low + 25 sex 2 ph.ecog 0 time 60 estimate + 26 sex 2 ph.ecog 0 time 60 conf.high + 27 sex 2 ph.ecog 0 time 60 conf.low + 28 sex 2 ph.ecog 0 time 180 estimate + 29 sex 2 ph.ecog 0 time 180 conf.high + 30 sex 2 ph.ecog 0 time 180 conf.low + 31 sex 2 ph.ecog 1 time 60 estimate + 32 sex 2 ph.ecog 1 time 60 conf.high + 33 sex 2 ph.ecog 1 time 60 conf.low + 34 sex 2 ph.ecog 1 time 180 estimate + 35 sex 2 ph.ecog 1 time 180 conf.high + 36 sex 2 ph.ecog 1 time 180 conf.low + 37 sex 2 ph.ecog 2 time 60 estimate + 38 sex 2 ph.ecog 2 time 60 conf.high + 39 sex 2 ph.ecog 2 time 60 conf.low + 40 sex 2 ph.ecog 2 time 180 estimate + 41 sex 2 ph.ecog 2 time 180 conf.high + 42 sex 2 ph.ecog 2 time 180 conf.low + stat_label stat + 1 Survival… 0.889 + 2 CI Upper… 0.998 + 3 CI Lower… 0.792 + 4 Survival… 0.806 + 5 CI Upper… 0.946 + 6 CI Lower… 0.686 + 7 Survival… 0.944 + 8 CI Upper… 0.999 + 9 CI Lower… 0.892 + 10 Survival… 0.675 + 11 CI Upper… 0.794 + 12 CI Lower… 0.574 + 13 Survival… 0.759 + 14 CI Upper… 0.932 + 15 CI Lower… 0.618 + 16 Survival… 0.414 + 17 CI Upper… 0.638 + 18 CI Lower… 0.268 + 19 Survival… 1 + 20 CI Upper… 1 + 21 CI Lower… 1 + 22 Survival… NA + 23 CI Upper… NA + 24 CI Lower… NA + 25 Survival… 0.963 + 26 CI Upper… 1 + 27 CI Lower… 0.894 + 28 Survival… 0.889 + 29 CI Upper… 1 + 30 CI Lower… 0.778 + 31 Survival… 0.976 + 32 CI Upper… 1 + 33 CI Lower… 0.931 + 34 Survival… 0.881 + 35 CI Upper… 0.985 + 36 CI Lower… 0.788 + 37 Survival… 1 + 38 CI Upper… 1 + 39 CI Lower… 1 + 40 Survival… 0.69 + 41 CI Upper… 0.931 + 42 CI Lower… 0.511 + Message + i 2 more variables: context, fmt_fn + +--- + + Code + print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ + sex + ph.ecog, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + Message + {cards} data frame: 42 x 11 + Output + group1 group1_level group2 group2_level variable variable_level stat_name + 1 sex 1 ph.ecog 0 prob 0.5 estimate + 2 sex 1 ph.ecog 0 prob 0.5 conf.high + 3 sex 1 ph.ecog 0 prob 0.5 conf.low + 4 sex 1 ph.ecog 0 prob 0.75 estimate + 5 sex 1 ph.ecog 0 prob 0.75 conf.high + 6 sex 1 ph.ecog 0 prob 0.75 conf.low + 7 sex 1 ph.ecog 1 prob 0.5 estimate + 8 sex 1 ph.ecog 1 prob 0.5 conf.high + 9 sex 1 ph.ecog 1 prob 0.5 conf.low + 10 sex 1 ph.ecog 1 prob 0.75 estimate + 11 sex 1 ph.ecog 1 prob 0.75 conf.high + 12 sex 1 ph.ecog 1 prob 0.75 conf.low + 13 sex 1 ph.ecog 2 prob 0.5 estimate + 14 sex 1 ph.ecog 2 prob 0.5 conf.high + 15 sex 1 ph.ecog 2 prob 0.5 conf.low + 16 sex 1 ph.ecog 2 prob 0.75 estimate + 17 sex 1 ph.ecog 2 prob 0.75 conf.high + 18 sex 1 ph.ecog 2 prob 0.75 conf.low + 19 sex 1 ph.ecog 3 prob 0.5 estimate + 20 sex 1 ph.ecog 3 prob 0.5 conf.high + 21 sex 1 ph.ecog 3 prob 0.5 conf.low + 22 sex 1 ph.ecog 3 prob 0.75 estimate + 23 sex 1 ph.ecog 3 prob 0.75 conf.high + 24 sex 1 ph.ecog 3 prob 0.75 conf.low + 25 sex 2 ph.ecog 0 prob 0.5 estimate + 26 sex 2 ph.ecog 0 prob 0.5 conf.high + 27 sex 2 ph.ecog 0 prob 0.5 conf.low + 28 sex 2 ph.ecog 0 prob 0.75 estimate + 29 sex 2 ph.ecog 0 prob 0.75 conf.high + 30 sex 2 ph.ecog 0 prob 0.75 conf.low + 31 sex 2 ph.ecog 1 prob 0.5 estimate + 32 sex 2 ph.ecog 1 prob 0.5 conf.high + 33 sex 2 ph.ecog 1 prob 0.5 conf.low + 34 sex 2 ph.ecog 1 prob 0.75 estimate + 35 sex 2 ph.ecog 1 prob 0.75 conf.high + 36 sex 2 ph.ecog 1 prob 0.75 conf.low + 37 sex 2 ph.ecog 2 prob 0.5 estimate + 38 sex 2 ph.ecog 2 prob 0.5 conf.high + 39 sex 2 ph.ecog 2 prob 0.5 conf.low + 40 sex 2 ph.ecog 2 prob 0.75 estimate + 41 sex 2 ph.ecog 2 prob 0.75 conf.high + 42 sex 2 ph.ecog 2 prob 0.75 conf.low + stat_label stat + 1 Survival… 353 + 2 CI Upper… 558 + 3 CI Lower… 303 + 4 Survival… 574 + 5 CI Upper… NA + 6 CI Lower… 428 + 7 Survival… 239 + 8 CI Upper… 363 + 9 CI Lower… 207 + 10 Survival… 460 + 11 CI Upper… 624 + 12 CI Lower… 363 + 13 Survival… 166 + 14 CI Upper… 288 + 15 CI Lower… 105 + 16 Survival… 291 + 17 CI Upper… NA + 18 CI Lower… 183 + 19 Survival… 118 + 20 CI Upper… NA + 21 CI Lower… NA + 22 Survival… 118 + 23 CI Upper… NA + 24 CI Lower… NA + 25 Survival… 705 + 26 CI Upper… NA + 27 CI Lower… 350 + 28 Survival… NA + 29 CI Upper… NA + 30 CI Lower… 705 + 31 Survival… 450 + 32 CI Upper… 687 + 33 CI Lower… 345 + 34 Survival… 728 + 35 CI Upper… NA + 36 CI Lower… 524 + 37 Survival… 239 + 38 CI Upper… 444 + 39 CI Lower… 199 + 40 Survival… 361 + 41 CI Upper… NA + 42 CI Lower… 285 + Message + i 2 more variables: context, fmt_fn + # ard_survfit() works with competing risks Code diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 1df2232aa..cf7d68c1d 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -53,6 +53,26 @@ test_that("ard_survfit() works with unstratified model", { ) }) +test_that("ard_survfit() works with multiple stratification variables", { + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) + + expect_snapshot( + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + ard_survfit(probs = c(0.5, 0.75)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) |> + print(n = Inf) + ) +}) + test_that("ard_survfit() works with competing risks", { set.seed(1) ADTTE_MS <- cards::ADTTE %>% From 1f221381ec2fcbe09fc10772af5d10d1337e499a Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 20 Mar 2024 17:25:06 -0400 Subject: [PATCH 29/34] Pass ard structure check --- R/ard_survfit.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index e86a46e5b..989ed9d9a 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -313,6 +313,11 @@ extract_multi_strata <- function(x, df_stat) { ), stat_label = dplyr::coalesce(.data$stat_label, .data$stat_name) ) %>% + dplyr::mutate(dplyr::across(matches("group[0-9]*_level"), ~ as.list(as.factor(.x)))) %>% + dplyr::mutate( + warning = list(NULL), + error = list(NULL) + ) %>% structure(., class = c("card", class(.))) %>% cards::tidy_ard_column_order() %>% cards::tidy_ard_row_order() From ef7960f89f4bf5a136e6b451baf9fa4055d615e3 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 20 Mar 2024 17:49:47 -0400 Subject: [PATCH 30/34] Allow non-syntactic names --- R/ard_survfit.R | 2 ++ tests/testthat/_snaps/ard_survfit.md | 32 ++++++++++++++-------------- tests/testthat/test-ard_survfit.R | 15 +++++++++++++ 3 files changed, 33 insertions(+), 16 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 989ed9d9a..2c1361fee 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -240,10 +240,12 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # process multiple stratifying variables extract_multi_strata <- function(x, df_stat) { x_terms <- attr(terms(as.formula(x$call$formula)), "term.labels") + x_terms <- gsub(".*\\(", "", gsub("\\)", "", x_terms)) if (length(x_terms) > 1) { strata_lvls <- data.frame() for (i in df_stat$strata) { + i <- gsub(".*\\(", "", gsub("\\)", "", i)) terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[1]] s_lvl <- terms_str[nchar(terms_str) > 0] strata_lvls <- rbind(strata_lvls, s_lvl) diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 8549f7e97..aadfb9763 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -5,7 +5,7 @@ TRTA, cards::ADTTE), times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 18 x 9 + {cards} data frame: 18 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo time 60 estimate Survival… 0.893 @@ -27,7 +27,7 @@ 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.743 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.195 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error # ard_survfit() works with different type @@ -36,7 +36,7 @@ TRTA, cards::ADTTE), times = c(60, 180), type = "risk"), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 18 x 9 + {cards} data frame: 18 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo time 60 estimate Survival… 0.107 @@ -58,7 +58,7 @@ 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.805 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.257 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error # ard_survfit() works with probs provided @@ -68,7 +68,7 @@ stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message The `type` argument is ignored for survival quantile estimation. - {cards} data frame: 18 x 9 + {cards} data frame: 18 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo prob 0.25 estimate Survival… 142 @@ -90,7 +90,7 @@ 17 TRTA Xanomeli… prob 0.75 conf.high CI Upper… NA 18 TRTA Xanomeli… prob 0.75 conf.low CI Lower… 180 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error # ard_survfit() works with unstratified model @@ -99,7 +99,7 @@ 1, data = lung), times = c(60, 180)), stat = lapply(stat, function(x) ifelse( is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 6 x 7 + {cards} data frame: 6 x 9 Output variable variable_level context stat_name stat_label stat 1 time 60 survival estimate Survival… 0.925 @@ -109,7 +109,7 @@ 5 time 180 survival conf.high CI Upper… 0.783 6 time 180 survival conf.low CI Lower… 0.666 Message - i 1 more variable: fmt_fn + i 3 more variables: fmt_fn, warning, error --- @@ -118,7 +118,7 @@ 1, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 6 x 7 + {cards} data frame: 6 x 9 Output variable variable_level context stat_name stat_label stat 1 prob 0.5 survival estimate Survival… 310 @@ -128,7 +128,7 @@ 5 prob 0.75 survival conf.high CI Upper… 654 6 prob 0.75 survival conf.low CI Lower… 460 Message - i 1 more variable: fmt_fn + i 3 more variables: fmt_fn, warning, error # ard_survfit() works with multiple stratification variables @@ -137,7 +137,7 @@ sex + ph.ecog, data = lung), times = c(60, 180)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 42 x 11 + {cards} data frame: 42 x 13 Output group1 group1_level group2 group2_level variable variable_level stat_name 1 sex 1 ph.ecog 0 time 60 estimate @@ -226,7 +226,7 @@ 41 CI Upper… 0.931 42 CI Lower… 0.511 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error --- @@ -235,7 +235,7 @@ sex + ph.ecog, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - {cards} data frame: 42 x 11 + {cards} data frame: 42 x 13 Output group1 group1_level group2 group2_level variable variable_level stat_name 1 sex 1 ph.ecog 0 prob 0.5 estimate @@ -324,7 +324,7 @@ 41 CI Upper… NA 42 CI Lower… 285 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error # ard_survfit() works with competing risks @@ -334,7 +334,7 @@ is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message Multi-state model detected. Showing probabilities into state 'death from cancer'. - {cards} data frame: 18 x 9 + {cards} data frame: 18 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat 1 TRTA Placebo time 60 estimate Survival… 0.054 @@ -356,7 +356,7 @@ 17 TRTA Xanomeli… time 180 conf.high CI Upper… 0.516 18 TRTA Xanomeli… time 180 conf.low CI Lower… 0.115 Message - i 2 more variables: context, fmt_fn + i 4 more variables: context, fmt_fn, warning, error # ard_survfit() errors are properly handled diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index cf7d68c1d..c371c3372 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -112,3 +112,18 @@ test_that("ard_survfit() errors are properly handled", { error = TRUE ) }) + +test_that("ard_survfit() works with non-syntactic names", { + expect_equal( + survival::survfit(survival::Surv(time, status) ~ factor(sex) + `ph.ecog`, data = lung) |> + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ), + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + ard_survfit(times = c(60, 180)) |> + dplyr::mutate( + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) + ) + ) +}) From 8c4d0f72045b2499ce1d41455a3fa91addd2086a Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Wed, 20 Mar 2024 18:06:00 -0400 Subject: [PATCH 31/34] Fix checks --- R/ard_survfit.R | 8 ++++---- tests/testthat/_snaps/ard_survfit.md | 16 ++++++++-------- tests/testthat/test-ard_survfit.R | 12 ++++++------ 3 files changed, 18 insertions(+), 18 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index 2c1361fee..b861e193e 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -230,7 +230,7 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { dplyr::mutate(context = "survival") %>% dplyr::as_tibble() - if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-strata) + if (length(x$n) == 1) df_stat <- df_stat %>% dplyr::select(-"strata") df_stat <- extract_multi_strata(x, df_stat) @@ -239,12 +239,12 @@ ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { # process multiple stratifying variables extract_multi_strata <- function(x, df_stat) { - x_terms <- attr(terms(as.formula(x$call$formula)), "term.labels") + x_terms <- attr(stats::terms(stats::as.formula(x$call$formula)), "term.labels") x_terms <- gsub(".*\\(", "", gsub("\\)", "", x_terms)) if (length(x_terms) > 1) { strata_lvls <- data.frame() - for (i in df_stat$strata) { + for (i in df_stat[["strata"]]) { i <- gsub(".*\\(", "", gsub("\\)", "", i)) terms_str <- strsplit(i, paste(c(paste0(x_terms, "="), paste0(", ", x_terms, "=")), collapse = "|"))[[1]] s_lvl <- terms_str[nchar(terms_str) > 0] @@ -256,7 +256,7 @@ extract_multi_strata <- function(x, df_stat) { t(sapply(seq_along(x_terms), function(i) c(paste0("group", i, "_level"), paste0("group", i)))) ) df_stat <- cbind(df_stat, strata_lvls) %>% - dplyr::select(-strata) + dplyr::select(-"strata") } } df_stat diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index aadfb9763..a6fa92a06 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -96,8 +96,8 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - 1, data = lung), times = c(60, 180)), stat = lapply(stat, function(x) ifelse( - is.numeric(x), cards::round5(x, 3), x))), n = Inf) + 1, data = survival::lung), times = c(60, 180)), stat = lapply(stat, function( + x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 6 x 9 Output @@ -115,8 +115,8 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - 1, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, function(x) - ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + 1, data = survival::lung), probs = c(0.5, 0.75)), stat = lapply(stat, + function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 6 x 9 Output @@ -134,8 +134,8 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - sex + ph.ecog, data = lung), times = c(60, 180)), stat = lapply(stat, - function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + sex + ph.ecog, data = survival::lung), times = c(60, 180)), stat = lapply( + stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 42 x 13 Output @@ -232,8 +232,8 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - sex + ph.ecog, data = lung), probs = c(0.5, 0.75)), stat = lapply(stat, - function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + sex + ph.ecog, data = survival::lung), probs = c(0.5, 0.75)), stat = lapply( + stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message {cards} data frame: 42 x 13 Output diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index c371c3372..71485c566 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -35,7 +35,7 @@ test_that("ard_survfit() works with probs provided", { test_that("ard_survfit() works with unstratified model", { expect_snapshot( - survival::survfit(survival::Surv(time, status) ~ 1, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ 1, data = survival::lung) |> ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) @@ -44,7 +44,7 @@ test_that("ard_survfit() works with unstratified model", { ) expect_snapshot( - survival::survfit(survival::Surv(time, status) ~ 1, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ 1, data = survival::lung) |> ard_survfit(probs = c(0.5, 0.75)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) @@ -55,7 +55,7 @@ test_that("ard_survfit() works with unstratified model", { test_that("ard_survfit() works with multiple stratification variables", { expect_snapshot( - survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) @@ -64,7 +64,7 @@ test_that("ard_survfit() works with multiple stratification variables", { ) expect_snapshot( - survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> ard_survfit(probs = c(0.5, 0.75)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) @@ -115,12 +115,12 @@ test_that("ard_survfit() errors are properly handled", { test_that("ard_survfit() works with non-syntactic names", { expect_equal( - survival::survfit(survival::Surv(time, status) ~ factor(sex) + `ph.ecog`, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ factor(sex) + `ph.ecog`, data = survival::lung) |> ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ), - survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = lung) |> + survival::survfit(survival::Surv(time, status) ~ sex + ph.ecog, data = survival::lung) |> ard_survfit(times = c(60, 180)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) From 5bf318e2654827d9ee9b8ce0d9204a00b208f765 Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Fri, 29 Mar 2024 20:06:52 -0700 Subject: [PATCH 32/34] lil updates --- R/ard_survfit.R | 37 ++++++++++++++++------------ man/ard_survfit.Rd | 6 ++--- man/dot-process_survfit_time.Rd | 4 +-- tests/testthat/_snaps/ard_survfit.md | 17 +++++++++---- tests/testthat/test-ard_survfit.R | 12 ++++++++- 5 files changed, 49 insertions(+), 27 deletions(-) diff --git a/R/ard_survfit.R b/R/ard_survfit.R index b861e193e..e13709af4 100644 --- a/R/ard_survfit.R +++ b/R/ard_survfit.R @@ -10,9 +10,9 @@ #' a vector of times for which to return survival probabilities. #' @param probs (`numeric`)\cr #' a vector of probabilities with values in (0,1) specifying the survival quantiles to return. -#' @param type (`character` or `NULL`)\cr +#' @param type (`string` or `NULL`)\cr #' type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise `type` -#' is ignored. Default is `"survival"`. +#' is ignored. Default is `NULL`. #' Must be one of the following: #' ```{r, echo = FALSE} #' dplyr::tribble( @@ -58,35 +58,40 @@ NULL #' @rdname ard_survfit #' @export -ard_survfit <- function(x, times = NULL, probs = NULL, type = "survival") { +ard_survfit <- function(x, times = NULL, probs = NULL, type = NULL) { # check installed packages --------------------------------------------------- cards::check_pkg_installed(c("survival", "broom"), reference_pkg = "cardx") # check/process inputs ------------------------------------------------------- check_not_missing(x) - check_class(type, "character") - if (!is.null(probs)) check_range(probs, c(0, 1)) - if (!all(inherits(x, "survfit"))) { - cli::cli_abort( - "The {.arg x} argument must be class {.cls survfit} created using the {.fun survival::survfit} function." - ) + check_class(x, cls = "survfit") + if (inherits(x, "survfitcox")) { + cli::cli_abort("Argument {.arg x} cannot be class {.cls survfitcox}.") + } + + # competing risks models cannot use the type argument + if (inherits(x, c("survfitms", "survfitcoxms")) && !is.null(type)) { + cli::cli_abort("Cannot use {.arg type} argument with {.code survfit} models with class {.cls {c('survfitms', 'survfitcoxms')}}.") } + if (!is.null(probs)) check_range(probs, c(0, 1)) if (sum(is.null(times), is.null(probs)) != 1) { cli::cli_abort("One and only one of {.arg times} and {.arg probs} must be specified.") } - if (!is.null(times) && !is.null(type) && !type %in% c("survival", "risk", "cumhaz")) { - cli::cli_abort( - "The {.arg type} argument is {.val {type}} but must be one of {.val survival}, {.val risk}, or {.val cumhaz}." - ) + + # for regular KM estimators, we allow the type argument + if (!inherits(x, "survfitms") && !is.null(type)) { + type <- arg_match(type, values = c("survival", "risk", "cumhaz")) } - if (type != "survival" && !is.null(probs)) { - cli::cli_inform("The {.arg type} argument is ignored for survival quantile estimation.") + + # cannot specify type arg when probs supplied + if (!is.null(probs) && !is.null(type)) { + cli::cli_abort("Cannot use {.arg type} argument when {.arg probs} argument specifed.") } # build ARD ------------------------------------------------------------------ est_type <- ifelse(is.null(probs), "times", "probs") tidy_survfit <- switch(est_type, - "times" = .process_survfit_time(x, times, type), + "times" = .process_survfit_time(x, times, type %||% "survival"), "probs" = .process_survfit_probs(x, probs) ) diff --git a/man/ard_survfit.Rd b/man/ard_survfit.Rd index 414e16df1..56eeac987 100644 --- a/man/ard_survfit.Rd +++ b/man/ard_survfit.Rd @@ -4,7 +4,7 @@ \alias{ard_survfit} \title{ARD Survival Estimates} \usage{ -ard_survfit(x, times = NULL, probs = NULL, type = "survival") +ard_survfit(x, times = NULL, probs = NULL, type = NULL) } \arguments{ \item{x}{(\code{\link[survival:survfit]{survival::survfit()}})\cr @@ -16,9 +16,9 @@ a vector of times for which to return survival probabilities.} \item{probs}{(\code{numeric})\cr a vector of probabilities with values in (0,1) specifying the survival quantiles to return.} -\item{type}{(\code{character} or \code{NULL})\cr +\item{type}{(\code{string} or \code{NULL})\cr type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} -is ignored. Default is \code{"survival"}. +is ignored. Default is \code{NULL}. Must be one of the following:\tabular{ll}{ type \tab transformation \cr \code{"survival"} \tab \code{x} \cr diff --git a/man/dot-process_survfit_time.Rd b/man/dot-process_survfit_time.Rd index d9133779a..6fe6a0dd7 100644 --- a/man/dot-process_survfit_time.Rd +++ b/man/dot-process_survfit_time.Rd @@ -13,9 +13,9 @@ a \code{\link[survival:survfit]{survival::survfit()}} object. See below for deta \item{times}{(\code{numeric})\cr a vector of times for which to return survival probabilities.} -\item{type}{(\code{character} or \code{NULL})\cr +\item{type}{(\code{string} or \code{NULL})\cr type of statistic to report. Available for Kaplan-Meier time estimates only, otherwise \code{type} -is ignored. Default is \code{"survival"}. +is ignored. Default is \code{NULL}. Must be one of the following:\tabular{ll}{ type \tab transformation \cr \code{"survival"} \tab \code{x} \cr diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index a6fa92a06..6d20bbdc1 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -64,10 +64,9 @@ Code print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(AVAL, CNSR) ~ - TRTA, cards::ADTTE), probs = c(0.25, 0.75), type = "cumhaz"), stat = lapply( - stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + TRTA, cards::ADTTE), probs = c(0.25, 0.75)), stat = lapply(stat, function(x) + ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) Message - The `type` argument is ignored for survival quantile estimation. {cards} data frame: 18 x 11 Output group1 group1_level variable variable_level stat_name stat_label stat @@ -364,7 +363,7 @@ ard_survfit("not_survfit") Condition Error in `ard_survfit()`: - ! The `x` argument must be class created using the `survival::survfit()` function. + ! The `x` argument must be class , not a string. --- @@ -373,7 +372,7 @@ times = 100, type = "notatype") Condition Error in `ard_survfit()`: - ! The `type` argument is "notatype" but must be one of "survival", "risk", or "cumhaz". + ! `type` must be one of "survival", "risk", or "cumhaz", not "notatype". --- @@ -384,3 +383,11 @@ Error in `ard_survfit()`: ! One and only one of `times` and `probs` must be specified. +# ard_survfit() errors with stratified Cox model + + Code + ard_survfit(survfit(coxph(Surv(time, status) ~ age + strata(sex), survival::lung))) + Condition + Error in `ard_survfit()`: + ! Argument `x` cannot be class . + diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 71485c566..875a9ac7a 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -25,7 +25,7 @@ test_that("ard_survfit() works with different type", { test_that("ard_survfit() works with probs provided", { expect_snapshot( survival::survfit(survival::Surv(AVAL, CNSR) ~ TRTA, cards::ADTTE) |> - ard_survfit(probs = c(0.25, 0.75), type = "cumhaz") |> + ard_survfit(probs = c(0.25, 0.75)) |> dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> @@ -127,3 +127,13 @@ test_that("ard_survfit() works with non-syntactic names", { ) ) }) + +test_that("ard_survfit() errors with stratified Cox model", { + withr::local_namespace("survival") + expect_snapshot( + error = TRUE, + coxph(Surv(time, status) ~ age + strata(sex), survival::lung) |> + survfit() |> + ard_survfit() + ) +}) From 8686a20164d149b378263917d5fc35e9a6a27549 Mon Sep 17 00:00:00 2001 From: Emily de la Rua Date: Thu, 4 Apr 2024 14:44:37 -0400 Subject: [PATCH 33/34] Shrink test snapshot output --- tests/testthat/_snaps/ard_survfit.md | 236 ++++++--------------------- tests/testthat/test-ard_survfit.R | 4 + 2 files changed, 56 insertions(+), 184 deletions(-) diff --git a/tests/testthat/_snaps/ard_survfit.md b/tests/testthat/_snaps/ard_survfit.md index 6d20bbdc1..5d209bb98 100644 --- a/tests/testthat/_snaps/ard_survfit.md +++ b/tests/testthat/_snaps/ard_survfit.md @@ -132,198 +132,66 @@ # ard_survfit() works with multiple stratification variables Code - print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - sex + ph.ecog, data = survival::lung), times = c(60, 180)), stat = lapply( - stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + print(head(dplyr::select(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv( + time, status) ~ sex + ph.ecog, data = survival::lung), times = c(60, 180)), + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), + "group1", "group1_level", "group2", "group2_level"), 20), n = Inf) Message - {cards} data frame: 42 x 13 + {cards} data frame: 20 x 4 Output - group1 group1_level group2 group2_level variable variable_level stat_name - 1 sex 1 ph.ecog 0 time 60 estimate - 2 sex 1 ph.ecog 0 time 60 conf.high - 3 sex 1 ph.ecog 0 time 60 conf.low - 4 sex 1 ph.ecog 0 time 180 estimate - 5 sex 1 ph.ecog 0 time 180 conf.high - 6 sex 1 ph.ecog 0 time 180 conf.low - 7 sex 1 ph.ecog 1 time 60 estimate - 8 sex 1 ph.ecog 1 time 60 conf.high - 9 sex 1 ph.ecog 1 time 60 conf.low - 10 sex 1 ph.ecog 1 time 180 estimate - 11 sex 1 ph.ecog 1 time 180 conf.high - 12 sex 1 ph.ecog 1 time 180 conf.low - 13 sex 1 ph.ecog 2 time 60 estimate - 14 sex 1 ph.ecog 2 time 60 conf.high - 15 sex 1 ph.ecog 2 time 60 conf.low - 16 sex 1 ph.ecog 2 time 180 estimate - 17 sex 1 ph.ecog 2 time 180 conf.high - 18 sex 1 ph.ecog 2 time 180 conf.low - 19 sex 1 ph.ecog 3 time 60 estimate - 20 sex 1 ph.ecog 3 time 60 conf.high - 21 sex 1 ph.ecog 3 time 60 conf.low - 22 sex 1 ph.ecog 3 time 180 estimate - 23 sex 1 ph.ecog 3 time 180 conf.high - 24 sex 1 ph.ecog 3 time 180 conf.low - 25 sex 2 ph.ecog 0 time 60 estimate - 26 sex 2 ph.ecog 0 time 60 conf.high - 27 sex 2 ph.ecog 0 time 60 conf.low - 28 sex 2 ph.ecog 0 time 180 estimate - 29 sex 2 ph.ecog 0 time 180 conf.high - 30 sex 2 ph.ecog 0 time 180 conf.low - 31 sex 2 ph.ecog 1 time 60 estimate - 32 sex 2 ph.ecog 1 time 60 conf.high - 33 sex 2 ph.ecog 1 time 60 conf.low - 34 sex 2 ph.ecog 1 time 180 estimate - 35 sex 2 ph.ecog 1 time 180 conf.high - 36 sex 2 ph.ecog 1 time 180 conf.low - 37 sex 2 ph.ecog 2 time 60 estimate - 38 sex 2 ph.ecog 2 time 60 conf.high - 39 sex 2 ph.ecog 2 time 60 conf.low - 40 sex 2 ph.ecog 2 time 180 estimate - 41 sex 2 ph.ecog 2 time 180 conf.high - 42 sex 2 ph.ecog 2 time 180 conf.low - stat_label stat - 1 Survival… 0.889 - 2 CI Upper… 0.998 - 3 CI Lower… 0.792 - 4 Survival… 0.806 - 5 CI Upper… 0.946 - 6 CI Lower… 0.686 - 7 Survival… 0.944 - 8 CI Upper… 0.999 - 9 CI Lower… 0.892 - 10 Survival… 0.675 - 11 CI Upper… 0.794 - 12 CI Lower… 0.574 - 13 Survival… 0.759 - 14 CI Upper… 0.932 - 15 CI Lower… 0.618 - 16 Survival… 0.414 - 17 CI Upper… 0.638 - 18 CI Lower… 0.268 - 19 Survival… 1 - 20 CI Upper… 1 - 21 CI Lower… 1 - 22 Survival… NA - 23 CI Upper… NA - 24 CI Lower… NA - 25 Survival… 0.963 - 26 CI Upper… 1 - 27 CI Lower… 0.894 - 28 Survival… 0.889 - 29 CI Upper… 1 - 30 CI Lower… 0.778 - 31 Survival… 0.976 - 32 CI Upper… 1 - 33 CI Lower… 0.931 - 34 Survival… 0.881 - 35 CI Upper… 0.985 - 36 CI Lower… 0.788 - 37 Survival… 1 - 38 CI Upper… 1 - 39 CI Lower… 1 - 40 Survival… 0.69 - 41 CI Upper… 0.931 - 42 CI Lower… 0.511 - Message - i 4 more variables: context, fmt_fn, warning, error + group1 group1_level group2 group2_level + 1 sex 1 ph.ecog 0 + 2 sex 1 ph.ecog 0 + 3 sex 1 ph.ecog 0 + 4 sex 1 ph.ecog 0 + 5 sex 1 ph.ecog 0 + 6 sex 1 ph.ecog 0 + 7 sex 1 ph.ecog 1 + 8 sex 1 ph.ecog 1 + 9 sex 1 ph.ecog 1 + 10 sex 1 ph.ecog 1 + 11 sex 1 ph.ecog 1 + 12 sex 1 ph.ecog 1 + 13 sex 1 ph.ecog 2 + 14 sex 1 ph.ecog 2 + 15 sex 1 ph.ecog 2 + 16 sex 1 ph.ecog 2 + 17 sex 1 ph.ecog 2 + 18 sex 1 ph.ecog 2 + 19 sex 1 ph.ecog 3 + 20 sex 1 ph.ecog 3 --- Code - print(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv(time, status) ~ - sex + ph.ecog, data = survival::lung), probs = c(0.5, 0.75)), stat = lapply( - stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), n = Inf) + print(head(dplyr::select(dplyr::mutate(ard_survfit(survival::survfit(survival::Surv( + time, status) ~ sex + ph.ecog, data = survival::lung), probs = c(0.5, 0.75)), + stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x))), + "group1", "group1_level", "group2", "group2_level"), 20), n = Inf) Message - {cards} data frame: 42 x 13 + {cards} data frame: 20 x 4 Output - group1 group1_level group2 group2_level variable variable_level stat_name - 1 sex 1 ph.ecog 0 prob 0.5 estimate - 2 sex 1 ph.ecog 0 prob 0.5 conf.high - 3 sex 1 ph.ecog 0 prob 0.5 conf.low - 4 sex 1 ph.ecog 0 prob 0.75 estimate - 5 sex 1 ph.ecog 0 prob 0.75 conf.high - 6 sex 1 ph.ecog 0 prob 0.75 conf.low - 7 sex 1 ph.ecog 1 prob 0.5 estimate - 8 sex 1 ph.ecog 1 prob 0.5 conf.high - 9 sex 1 ph.ecog 1 prob 0.5 conf.low - 10 sex 1 ph.ecog 1 prob 0.75 estimate - 11 sex 1 ph.ecog 1 prob 0.75 conf.high - 12 sex 1 ph.ecog 1 prob 0.75 conf.low - 13 sex 1 ph.ecog 2 prob 0.5 estimate - 14 sex 1 ph.ecog 2 prob 0.5 conf.high - 15 sex 1 ph.ecog 2 prob 0.5 conf.low - 16 sex 1 ph.ecog 2 prob 0.75 estimate - 17 sex 1 ph.ecog 2 prob 0.75 conf.high - 18 sex 1 ph.ecog 2 prob 0.75 conf.low - 19 sex 1 ph.ecog 3 prob 0.5 estimate - 20 sex 1 ph.ecog 3 prob 0.5 conf.high - 21 sex 1 ph.ecog 3 prob 0.5 conf.low - 22 sex 1 ph.ecog 3 prob 0.75 estimate - 23 sex 1 ph.ecog 3 prob 0.75 conf.high - 24 sex 1 ph.ecog 3 prob 0.75 conf.low - 25 sex 2 ph.ecog 0 prob 0.5 estimate - 26 sex 2 ph.ecog 0 prob 0.5 conf.high - 27 sex 2 ph.ecog 0 prob 0.5 conf.low - 28 sex 2 ph.ecog 0 prob 0.75 estimate - 29 sex 2 ph.ecog 0 prob 0.75 conf.high - 30 sex 2 ph.ecog 0 prob 0.75 conf.low - 31 sex 2 ph.ecog 1 prob 0.5 estimate - 32 sex 2 ph.ecog 1 prob 0.5 conf.high - 33 sex 2 ph.ecog 1 prob 0.5 conf.low - 34 sex 2 ph.ecog 1 prob 0.75 estimate - 35 sex 2 ph.ecog 1 prob 0.75 conf.high - 36 sex 2 ph.ecog 1 prob 0.75 conf.low - 37 sex 2 ph.ecog 2 prob 0.5 estimate - 38 sex 2 ph.ecog 2 prob 0.5 conf.high - 39 sex 2 ph.ecog 2 prob 0.5 conf.low - 40 sex 2 ph.ecog 2 prob 0.75 estimate - 41 sex 2 ph.ecog 2 prob 0.75 conf.high - 42 sex 2 ph.ecog 2 prob 0.75 conf.low - stat_label stat - 1 Survival… 353 - 2 CI Upper… 558 - 3 CI Lower… 303 - 4 Survival… 574 - 5 CI Upper… NA - 6 CI Lower… 428 - 7 Survival… 239 - 8 CI Upper… 363 - 9 CI Lower… 207 - 10 Survival… 460 - 11 CI Upper… 624 - 12 CI Lower… 363 - 13 Survival… 166 - 14 CI Upper… 288 - 15 CI Lower… 105 - 16 Survival… 291 - 17 CI Upper… NA - 18 CI Lower… 183 - 19 Survival… 118 - 20 CI Upper… NA - 21 CI Lower… NA - 22 Survival… 118 - 23 CI Upper… NA - 24 CI Lower… NA - 25 Survival… 705 - 26 CI Upper… NA - 27 CI Lower… 350 - 28 Survival… NA - 29 CI Upper… NA - 30 CI Lower… 705 - 31 Survival… 450 - 32 CI Upper… 687 - 33 CI Lower… 345 - 34 Survival… 728 - 35 CI Upper… NA - 36 CI Lower… 524 - 37 Survival… 239 - 38 CI Upper… 444 - 39 CI Lower… 199 - 40 Survival… 361 - 41 CI Upper… NA - 42 CI Lower… 285 - Message - i 4 more variables: context, fmt_fn, warning, error + group1 group1_level group2 group2_level + 1 sex 1 ph.ecog 0 + 2 sex 1 ph.ecog 0 + 3 sex 1 ph.ecog 0 + 4 sex 1 ph.ecog 0 + 5 sex 1 ph.ecog 0 + 6 sex 1 ph.ecog 0 + 7 sex 1 ph.ecog 1 + 8 sex 1 ph.ecog 1 + 9 sex 1 ph.ecog 1 + 10 sex 1 ph.ecog 1 + 11 sex 1 ph.ecog 1 + 12 sex 1 ph.ecog 1 + 13 sex 1 ph.ecog 2 + 14 sex 1 ph.ecog 2 + 15 sex 1 ph.ecog 2 + 16 sex 1 ph.ecog 2 + 17 sex 1 ph.ecog 2 + 18 sex 1 ph.ecog 2 + 19 sex 1 ph.ecog 3 + 20 sex 1 ph.ecog 3 # ard_survfit() works with competing risks diff --git a/tests/testthat/test-ard_survfit.R b/tests/testthat/test-ard_survfit.R index 875a9ac7a..80681fab5 100644 --- a/tests/testthat/test-ard_survfit.R +++ b/tests/testthat/test-ard_survfit.R @@ -60,6 +60,8 @@ test_that("ard_survfit() works with multiple stratification variables", { dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> + dplyr::select("group1", "group1_level", "group2", "group2_level") |> + head(20) |> print(n = Inf) ) @@ -69,6 +71,8 @@ test_that("ard_survfit() works with multiple stratification variables", { dplyr::mutate( stat = lapply(stat, function(x) ifelse(is.numeric(x), cards::round5(x, 3), x)) ) |> + dplyr::select("group1", "group1_level", "group2", "group2_level") |> + head(20) |> print(n = Inf) ) }) From 367ce2f3ef42b61b015768f0149b11d2d85850fc Mon Sep 17 00:00:00 2001 From: Daniel Sjoberg Date: Thu, 4 Apr 2024 15:58:44 -0700 Subject: [PATCH 34/34] Update NEWS.md --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 54733e01c..f38a43aa7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ - `ard_proptest()` for tests of proportions using `stats::prop.test()`. (#64) - `ard_regression_basic()` for basic regression models. The function focuses on matching terms to underlying variables names. (#46) - `ard_smd()` for calculating standardized mean differences using `smd::smd()`. (#4) + - `ard_survfit()` for survival analyses using `survival::survfit()`. (#43) - `ard_svycontinuous()` for calculating univariate summary statistics from weighted/survey data using many functions from the {survey} package. (#68) - `ard_svychisq()` for weighted/survey chi-squared test using `survey::svychisq()`. (#72) - `ard_svyttest()` for weighted/survey t-tests using `survey::svyttest()`. (#70)