From 3815bf284887897118f4dc11fb90246293ab3ac7 Mon Sep 17 00:00:00 2001 From: Kai Gu Date: Thu, 11 Apr 2024 23:00:09 +0800 Subject: [PATCH] update print method with rtables outputs --- DESCRIPTION | 1 + NAMESPACE | 7 + R/package.R | 2 + R/pkg-methods.R | 383 +++++++++++++---------- R/summarize-survival.R | 4 + man/s_get_coxph.Rd | 14 +- man/s_get_survfit.Rd | 16 +- tests/testthat/test-pkg-methods.R | 18 +- tests/testthat/test-summarize-survival.R | 33 +- 9 files changed, 274 insertions(+), 204 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 90cac95..350ce84 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -25,6 +25,7 @@ Imports: magrittr, purrr, rlang, + rtables, stats, survival, survminer, diff --git a/NAMESPACE b/NAMESPACE index bf1e170..db64a3b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -41,6 +41,13 @@ importFrom(magrittr,set_colnames) importFrom(rlang,":=") importFrom(rlang,.data) importFrom(rlang,sym) +importFrom(rtables,analyze) +importFrom(rtables,basic_table) +importFrom(rtables,build_table) +importFrom(rtables,in_rows) +importFrom(rtables,non_ref_rcell) +importFrom(rtables,rcell) +importFrom(rtables,split_cols_by) importFrom(stats,as.formula) importFrom(stats,coef) importFrom(stats,confint) diff --git a/R/package.R b/R/package.R index e096f7f..b53cd9d 100644 --- a/R/package.R +++ b/R/package.R @@ -11,6 +11,8 @@ #' @importFrom dplyr add_count arrange case_when count distinct filter full_join #' group_by left_join mutate row_number rowwise select summarise ungroup #' @importFrom rlang sym := .data +#' @importFrom rtables analyze basic_table build_table in_rows rcell non_ref_rcell +#' split_cols_by #' @importFrom survival coxph strata #' @importFrom survminer pairwise_survdiff #' @importFrom lubridate ymd days diff --git a/R/pkg-methods.R b/R/pkg-methods.R index 417a8c0..9759cc5 100644 --- a/R/pkg-methods.R +++ b/R/pkg-methods.R @@ -79,152 +79,171 @@ print.or_ci <- function(x, ...) { #' @describeIn s_get_survfit prints survival analysis summary from `survfit`. #' @exportS3Method #' @keywords internal -print.s_survival <- function(x, ...) { +#' @param fm (`string`)\cr string of unit for survival time. +print.s_survival <- function(x, fm = "months", ...) { cat("Surv formula: ", x$params$formula, "\n", sep = "") - cat("Group by: ", paste(unique(x$surv$quantile$group), collapse = ", "), "\n", sep = "") + grp <- unique(x$surv$quantile$group) + cat("Group by: ", paste(grp, collapse = ", "), "\n", sep = "") if (!is.null(x$params$strata)) { cat("Stratified by: ", paste(x$params$strata, collapse = ", "), "\n", sep = "") } cat("Confidence interval type: ", x$params$conf_type, "\n", sep = "") - cat("\n---\n") - cat("Time to Event:\n") - med <- x$surv$median %>% - rowwise() %>% - mutate( - `n(event)` = format_value(c(.data$n, .data$events), format = "xx (xx)"), - Median = paste( - format_value(.data$median, format = "xx.xx"), - format_value(c(.data$lower, .data$upper), - format = "(xx.xx, xx.xx)" - ) - ) - ) %>% - select("group", "n(event)", "Median") - quant <- x$surv$quantile %>% - rowwise() %>% - mutate( - surv = paste( - format_value(.data$time, format = "xx.xx"), - format_value(c(.data$lower, .data$upper), - format = "(xx.xx, xx.xx)" - ) + grp_var <- x$params$var + df <- x$data + ref_col <- grp[1] + comp_col <- grp[-1] + pval_name <- ifelse(x$params$rho == 0, "log-rank", "peto & peto") + + a_count_subjd <- function(df, .var, .N_col, res) { + surv_med <- res$surv$median %>% + mutate( + censors = .data$n - .data$events + ) %>% + tibble::column_to_rownames(var = "group") + ind <- grep(df[[.var]][1], row.names(surv_med), fixed = TRUE) + in_rows( + "Number of events" = rcell( + surv_med$events[ind] * c(1, 1 / .N_col), + format = "xx (xx.xx%)" + ), + "Number of consered" = rcell( + surv_med$censors[ind] * c(1, 1 / .N_col), + format = "xx (xx.xx%)" ) - ) %>% - tidyr::pivot_wider( - id_cols = "group", - names_from = "quantile", - names_glue = "Q{quantile}", - values_from = "surv" ) - rang <- x$surv$range %>% - rowwise() %>% - mutate( - `Range.event` = format_value(c(.data$event_min, .data$event_max), - format = "(xx.x, xx.x)" - ), - `Range.censor` = format_value(c(.data$censor_min, .data$censor_max), - format = "(xx.x, xx.x)" + } + + a_surv_time_func <- function(df, .var, res) { + med_tb <- res$surv$median %>% + tibble::column_to_rownames(var = "group") + quant_tb <- res$surv$quantile %>% + tidyr::pivot_longer(cols = -c(1, 2), values_to = "Value", names_to = "Stat") %>% + tidyr::pivot_wider( + id_cols = "group", + names_from = c("quantile", "Stat"), + names_glue = "Q{quantile}_{Stat}", + values_from = c("Value") + ) %>% + tibble::column_to_rownames(var = "group") + range_tb <- res$surv$range %>% + tibble::column_to_rownames(var = "group") + ind <- grep(df[[.var]][1], row.names(med_tb), fixed = TRUE) + med_time <- list(med_tb[ind, c("median", "lower", "upper")]) + quantile_time <- lapply(c(res$params$quantile * 100), function(x) { + unlist(c(quant_tb[ind, grep(paste0("Q", x), names(quant_tb))])) + }) + range_time <- list(range_tb[ind, c("min", "max")]) + in_rows( + .list = c(med_time, quantile_time, range_time), + .names = c( + "Median (95% CI)", + paste0(c(res$params$quantile * 100), "th percentile (95% CI)", sep = ""), + "Min, Max" ), - `Range` = format_value(c(.data$min, .data$max), - format = "(xx.x, xx.x)" + .formats = c( + "xx.xx (xx.xx - xx.xx)", + rep("xx.xx (xx.xx - xx.xx)", length(res$params$quantile)), + "(xx.xx, xx.xx)" ) - ) %>% - select("group", "Range.event", "Range.censor", "Range") - list(med, quant, rang) %>% - purrr::reduce(full_join, by = "group") %>% - tidyr::pivot_longer(cols = -1, values_to = "Value", names_to = "Stat") %>% - tidyr::pivot_wider(names_from = "group", values_from = "Value") %>% - tibble::column_to_rownames(var = "Stat") %>% - print(right = FALSE) - cat("\n") - - - if (!is.null(x$surv$time_point)) { - cat("---\n") - cat( - "At Specified Time Points (", - paste(unique(x$surv$time_point$time), collapse = ", "), "):\n", - sep = "" ) - x$surv$time_point %>% - rowwise() %>% - mutate( - `No. at risk` = as.character(.data$n.risk), - `No. event` = as.character(.data$n.event), - `No. consor` = as.character(.data$n.censor), - `Event-free rate` = paste( - format_value(.data$surv, format = "xx.xxx"), - format_value(c(.data$lower, .data$upper), - format = "(xx.xxx, xx.xxx)" - ) - ) - ) %>% - select( - "time", "No. at risk", "No. event", - "No. consor", "Event-free rate", "group" - ) %>% - ungroup() %>% - dplyr::group_split(.data$time) %>% - purrr::walk(.f = function(dt) { - dt %>% - select(-1) %>% - tidyr::pivot_longer(cols = -c("group"), values_to = "Value", names_to = "Stat") %>% - tidyr::pivot_wider(names_from = "group", values_from = "Value") %>% - tibble::column_to_rownames(var = "Stat") %>% - print(right = FALSE) - cat("\n") - }) } - if (!is.null(x$surv_diff$rate)) { - cat("---\n") - cat( - "Difference of Event-free Rate at Specified Time Points (", - paste(unique(x$surv$time_point$time), collapse = ","), "):\n", - sep = "" + tbl <- basic_table( + show_colcounts = TRUE + ) %>% + split_cols_by(grp_var, ref_group = ref_col) %>% + analyze(grp_var, a_count_subjd, + show_labels = "hidden", + extra_args = list(res = x) + ) %>% + analyze(grp_var, a_surv_time_func, + var_labels = "Time to event (months)", show_labels = "visible", + extra_args = list(res = x), + table_names = "kmtable" ) - x$surv_diff$rate %>% - rowwise() %>% - mutate( - `Diff` = paste( - format_value(.data$surv.diff, format = "xx.xxx"), - format_value(c(.data$lower, .data$upper), - format = "(xx.xxx, xx.xxx)" - ) + + if (!is.null(x$surv_diff$test)) { + a_surv_pval_func <- function(df, .var, .in_ref_col, res) { + curgrp <- df[[.var]][1] + pval_tb <- res$surv_diff$test %>% + filter(.data$reference == ref_col & .data$comparison == curgrp) + in_rows( + "P-value" = non_ref_rcell( + pval_tb[["pval"]], + .in_ref_col, + format = "x.xxxx | (<0.0001)" + ) + ) + } + tbl <- tbl %>% + analyze(grp_var, a_surv_pval_func, + var_labels = paste( + ifelse(is.null(x$params$strata), "Unstratified", "Stratified"), + paste(pval_name, "test") ), - `p-value` = format_value(.data$pval, "x.xxxx | (<0.0001)") - ) %>% - select( - "time", "Diff", "p-value", "group" - ) %>% - ungroup() %>% - dplyr::group_split(.data$time) %>% - purrr::walk(.f = function(dt) { - dt %>% - select(-1) %>% - tidyr::pivot_longer(cols = -c("group"), values_to = "Value", names_to = "Stat") %>% - tidyr::pivot_wider(names_from = "group", values_from = "Value") %>% - tibble::column_to_rownames(var = "Stat") %>% - print(right = FALSE) - cat("\n") - }) + show_labels = "visible", + extra_args = list(res = x), + table_names = "logrank" + ) } - method <- if (x$params$rho == 0) { - "Log-Rank" - } else if (x$params$rho == 1) { - "Peto & Peto" - } - if (!is.null(x$surv_diff$test)) { - cat("---\n") - cat("Hypothesis Testing with ", method, ":\n", sep = "") - x$surv_diff$test %>% - tidyr::pivot_wider(names_from = "comparsion", values_from = "pval") %>% - tibble::column_to_rownames(var = "method") %>% - print(right = FALSE) + if (!is.null(x$params$time_point)) { + a_surv_rate_func <- function(df, .var, .in_ref_col, rate_tb, rate_diff_tb) { + curgrp <- df[[.var]][1] + rate_diff_tb <- rate_diff_tb %>% + filter(.data$reference == ref_col & .data$comparison == curgrp) + ind <- grep(df[[.var]][1], row.names(rate_tb), fixed = TRUE) + in_rows( + rcell(rate_tb[ind, "n.risk", drop = TRUE], format = "xx"), + rcell(rate_tb[ind, "surv", drop = TRUE], format = "xx.xxx"), + rcell(unlist(rate_tb[ind, c("lower", "upper"), drop = TRUE]), format = "(xx.xxx, xx.xxx)"), + non_ref_rcell( + rate_diff_tb[, "surv.diff", drop = TRUE], + .in_ref_col, + format = "xx.xxx" + ), + non_ref_rcell( + unlist(rate_diff_tb[, c("lower", "upper"), drop = TRUE]), + .in_ref_col, + format = "(xx.xxx, xx.xxx)", + indent_mod = 1L + ), + non_ref_rcell( + rate_diff_tb[, "pval", drop = TRUE], + .in_ref_col, + format = "x.xxxx | (<0.0001)", + indent_mod = 1L + ), + .names = c( + "Number at risk", + "Event-free rate", "95% CI", + "Difference in Event Free Rate", "95% CI", + "p-value (Z-test)" + ) + ) + } + + time_point <- x$params$time_point + surv_rate <- x$surv$time_point %>% + split(as.formula("~time")) %>% + purrr::map(\(df) tibble::column_to_rownames(df, var = "group")) + surv_rate_diff <- x$surv_diff$rate %>% + split(as.formula("~time")) + for (i in seq_along(time_point)) { + tbl <- tbl |> + analyze(grp_var, a_surv_rate_func, + var_labels = paste(time_point[i], fm), show_labels = "visible", + extra_args = list(rate_tb = surv_rate[[i]], rate_diff_tb = surv_rate_diff[[i]]), + table_names = paste0("timepoint_", time_point[i]) + ) + } } + result <- tbl %>% + build_table(df) + print(result) + invisible(x) } @@ -233,55 +252,85 @@ print.s_survival <- function(x, ...) { #' @keywords internal print.s_coxph <- function(x, ...) { cat("Surv formula: ", x$params$formula, "\n", sep = "") - cat("Group by: ", paste(x$params$group, collapse = ", "), "\n", sep = "") + grp <- x$params$group + cat("Group by: ", paste(grp, collapse = ", "), "\n", sep = "") if (!is.null(x$params$strata)) { cat("Stratified by: ", paste(x$params$strata, collapse = ", "), "\n", sep = "") } cat("Tie method: ", x$params$ties, "\n", sep = "") - cat("P-value method for HR: ", - switch(x$params$pval_method, - all = paste(c("logtest", "sctest", "waldtest"), collapse = ", "), - log = "logtest", - sc = "sctest", - wald = "waldtest" - ), - "\n", - sep = "" + pval_name <- switch(x$params$pval_method, + all = c("logtest", "sctest", "waldtest"), + log = "logtest", + sc = "sctest", + wald = "waldtest" ) + cat("P-value method for HR: ", paste(pval_name, collapse = ", "), "\n\n", sep = "") - cat("\n---\n") - cat("Estimation of Hazard Ratio", - ifelse(!is.null(x$params$strata), " with Stratification", ""), ":\n", - sep = "" - ) - hr <- x$hr %>% - rowwise() %>% - mutate( - `n(event)` = format_value(c(.data$n, .data$events), format = "xx (xx)"), - `Hazard Ratio` = format_value(c(.data$hr, .data$lower, .data$upper), - format = "xx.xx (xx.xx - xx.xx)" + grp_var <- x$params$var + df <- x$data + ref_col <- grp[1] + + a_hr_func <- function(df, .var, .in_ref_col, res) { + if (.in_ref_col) { + ret <- replicate(2 + length(pval_name), list(rcell(NULL))) + } else { + curgrp <- df[[.var]][1] + hr_tb <- res$hr %>% + filter(.data$reference == ref_col & .data$comparison == curgrp) + pval_tb <- res$pval %>% + filter(.data$reference == ref_col & .data$comparison == curgrp) + ret <- list( + non_ref_rcell( + hr_tb[, "hr", drop = TRUE], + .in_ref_col, + format = "xx.xx" + ), + non_ref_rcell( + unlist(hr_tb[, c("lower", "upper"), drop = TRUE]), + .in_ref_col, + format = "(xx.xx, xx.xx)" + ) + ) + for (i in seq_along(pval_name)) { + ret <- c( + ret, + non_ref_rcell( + pval_tb[, "pval", drop = TRUE][i], + .in_ref_col, + format = "x.xxxx | (<0.0001)" + ) + ) + } + } + in_rows( + .list = ret, + .names = c( + "Hazard Ratio", "95% CI", + paste0("p-value (", pval_name, ")") + ), + .formats = c( + "xx.xx", + "(xx.xx, xx.xx)", + rep("x.xxxx | (<0.0001)", length(pval_name)) ) - ) %>% - select("comparsion", "n(event)", "Hazard Ratio") - pval <- x$pval %>% - rowwise() %>% - mutate( - pval = format_value(.data$pval, "x.xxxx | (<0.0001)") - ) %>% - select("comparsion", "method", "pval") %>% - tidyr::pivot_wider( - id_cols = "comparsion", - names_from = "method", - names_glue = "p-value ({method})", - values_from = "pval" ) + } - list(hr, pval) %>% - purrr::reduce(full_join, by = "comparsion") %>% - tidyr::pivot_longer(cols = -1, values_to = "Value", names_to = "Stat") %>% - tidyr::pivot_wider(names_from = "comparsion", values_from = "Value") %>% - tibble::column_to_rownames(var = "Stat") %>% - print(right = FALSE) + result <- basic_table( + show_colcounts = TRUE + ) %>% + split_cols_by(grp_var, ref_group = ref_col) %>% + analyze(grp_var, a_hr_func, + var_labels = paste( + ifelse(is.null(x$params$strata), "Unstratified", "Stratified"), + "Analysis" + ), + show_labels = "visible", + extra_args = list(res = x), + table_names = "coxph" + ) %>% + build_table(df) + print(result) invisible(x) } diff --git a/R/summarize-survival.R b/R/summarize-survival.R index a312947..6d89cd5 100644 --- a/R/summarize-survival.R +++ b/R/summarize-survival.R @@ -27,6 +27,8 @@ #' @param pairwise (`logical`)\cr whether to conduct the pairwise comparison. #' @param ... other arguments to be passed to [survival::survfit()]. #' +#' @order 1 +#' #' @return #' An object of class `s_survival` is a list contains several summary tables #' @@ -328,6 +330,8 @@ s_get_survfit <- function(data, #' @param pairwise (`logical`)\cr whether to conduct the pairwise comparison. #' @param ... other arguments to be passed to [survival::coxph()]. #' +#' @order 1 +#' #' @return #' An object of class `s_coxph` is a list contains hazards ratio and p-value tables. #' diff --git a/man/s_get_coxph.Rd b/man/s_get_coxph.Rd index 35660e8..f8f41a5 100644 --- a/man/s_get_coxph.Rd +++ b/man/s_get_coxph.Rd @@ -1,12 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg-methods.R, R/summarize-survival.R -\name{print.s_coxph} -\alias{print.s_coxph} +% Please edit documentation in R/summarize-survival.R, R/pkg-methods.R +\name{s_get_coxph} \alias{s_get_coxph} +\alias{print.s_coxph} \title{Summarize Cox Proportional Hazards Regression Model} \usage{ -\method{print}{s_coxph}(x, ...) - s_get_coxph( data, formula, @@ -17,10 +15,10 @@ s_get_coxph( pairwise = FALSE, ... ) + +\method{print}{s_coxph}(x, ...) } \arguments{ -\item{...}{other arguments to be passed to \code{\link[survival:coxph]{survival::coxph()}}.} - \item{data}{(\code{data.frame})\cr a data frame as input.} \item{formula}{(\code{formula})\cr a formula with survival object.} @@ -38,6 +36,8 @@ default is to present all three methods (Likelihood ratio test, Wald test and Score (logrank) test).} \item{pairwise}{(\code{logical})\cr whether to conduct the pairwise comparison.} + +\item{...}{other arguments to be passed to \code{\link[survival:coxph]{survival::coxph()}}.} } \value{ An object of class \code{s_coxph} is a list contains hazards ratio and p-value tables. diff --git a/man/s_get_survfit.Rd b/man/s_get_survfit.Rd index d1532ed..916beb9 100644 --- a/man/s_get_survfit.Rd +++ b/man/s_get_survfit.Rd @@ -1,14 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pkg-methods.R, R/summarize-survival.R, +% Please edit documentation in R/summarize-survival.R, R/pkg-methods.R, % R/utils.R -\name{print.s_survival} -\alias{print.s_survival} +\name{s_get_survfit} \alias{s_get_survfit} +\alias{print.s_survival} \alias{h_pairwise_survdiff} \title{Summarize Survival Curves Analysis} \usage{ -\method{print}{s_survival}(x, fm = "months", ...) - s_get_survfit( data, formula, @@ -22,11 +20,11 @@ s_get_survfit( ... ) +\method{print}{s_survival}(x, fm = "months", ...) + h_pairwise_survdiff(formula, data, strata = NULL, rho = 0) } \arguments{ -\item{...}{other arguments to be passed to \code{\link[survival:survfit]{survival::survfit()}}.} - \item{data}{(\code{data.frame})\cr a data frame as input.} \item{formula}{(\code{formula})\cr a formula of survival model with survival object. @@ -51,6 +49,10 @@ of comparing survival curves. Default is 0 that is log-rank , others options can see \code{\link[survival:survdiff]{survival::survdiff()}}.} \item{pairwise}{(\code{logical})\cr whether to conduct the pairwise comparison.} + +\item{...}{other arguments to be passed to \code{\link[survival:survfit]{survival::survfit()}}.} + +\item{fm}{(\code{string})\cr string of unit for survival time.} } \value{ An object of class \code{s_survival} is a list contains several summary tables diff --git a/tests/testthat/test-pkg-methods.R b/tests/testthat/test-pkg-methods.R index 27e66fa..cc4afc2 100644 --- a/tests/testthat/test-pkg-methods.R +++ b/tests/testthat/test-pkg-methods.R @@ -27,10 +27,10 @@ test_that("print.s_survival works as expected", { ) res <- capture_output(print(s_get_survfit(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB))) expect_match(res, "Surv formula: Surv(LENFOL, FSTAT) ~ AFB", fixed = TRUE) - expect_match(res, "Group by: AFB=1, AFB=0", fixed = TRUE) + expect_match(res, "Group by: 1, 0", fixed = TRUE) expect_match(res, "Confidence interval type: log-log", fixed = TRUE) - expect_match(res, "Time to Event", fixed = TRUE) - expect_match(res, "Hypothesis Testing with Log-Rank", fixed = TRUE) + expect_match(res, "Time to event (months)", fixed = TRUE) + expect_match(res, "Unstratified log-rank test", fixed = TRUE) res2 <- capture_output(print(s_get_survfit(data = dat, formula = Surv(LENFOL, FSTAT) ~ 1))) expect_match(res2, "Group by: Total", fixed = TRUE) @@ -40,8 +40,8 @@ test_that("print.s_survival works as expected", { formula = Surv(LENFOL, FSTAT) ~ AFB, time_point = c(12, 36, 60) ))) - expect_match(res3, "At Specified Time Points (12, 36, 60)", fixed = TRUE) - expect_match(res3, "Difference of Event-free Rate at Specified Time Points (12,36,60)", fixed = TRUE) + expect_match(res3, "Event-free rate", fixed = TRUE) + expect_match(res3, "Difference in Event Free Rate", fixed = TRUE) res4 <- capture_output(print(s_get_survfit( data = dat, @@ -59,10 +59,14 @@ test_that("print.s_coxph works as expected", { ) res <- capture_output(print(s_get_coxph(data = dat, formula = Surv(LENFOL, FSTAT) ~ AFB))) expect_match(res, "Surv formula: Surv(LENFOL, FSTAT) ~ AFB", fixed = TRUE) - expect_match(res, "Group by: AFB=1, AFB=0", fixed = TRUE) + expect_match(res, "Group by: 1, 0", fixed = TRUE) expect_match(res, "Tie method: efro", fixed = TRUE) expect_match(res, "P-value method for HR: logtest, sctest, waldtest", fixed = TRUE) - expect_match(res, "Estimation of Hazard Ratio", fixed = TRUE) + expect_match(res, "Unstratified Analysis", fixed = TRUE) + expect_match(res, "Hazard Ratio", fixed = TRUE) + expect_match(res, "p-value (logtest)", fixed = TRUE) + expect_match(res, "p-value (sctest)", fixed = TRUE) + expect_match(res, "p-value (waldtest)", fixed = TRUE) res2 <- capture_output(print(s_get_coxph( data = dat, diff --git a/tests/testthat/test-summarize-survival.R b/tests/testthat/test-summarize-survival.R index cc17407..3104996 100644 --- a/tests/testthat/test-summarize-survival.R +++ b/tests/testthat/test-summarize-survival.R @@ -32,15 +32,15 @@ test_that("s_get_survfit works as expected with default arguments in single grou ), tolerance = 0.0001 ) - expect_identical(dim(res$surv$overall), c(162L, 9L)) + expect_identical(dim(res$surv$overall), c(395L, 9L)) expect_equal( res$surv$range, tibble::tibble( group = "Total", event_min = 0.03285421, event_max = 77.47023, - censor_min = 12.55031, - censor_max = 77.20739, + censor_min = 12.09035, + censor_max = 72.01643, min = 0.03285421, max = 77.47023 ), @@ -62,7 +62,7 @@ test_that("s_get_survfit works as expected with default arguments in two groups" expect_equal( res$surv$median, tibble::tibble( - group = c("AFB=1", "AFB=0"), + group = c("1", "0"), n = c(78, 422), events = c(47, 168), median = c(28.41889, 70.96509), @@ -74,7 +74,7 @@ test_that("s_get_survfit works as expected with default arguments in two groups" expect_equal( res$surv$quantile, tibble::tibble( - group = rep(c("AFB=1", "AFB=0"), 2), + group = rep(c("1", "0"), 2), quantile = rep(c(25, 75), each = 2), time = c(3.12115, 11.33470, 77.20739, 77.30595), lower = c(0.5585216, 6.1437372, 50.8583162, 77.3059548), @@ -86,7 +86,8 @@ test_that("s_get_survfit works as expected with default arguments in two groups" expect_equal( res$surv_diff$test, tibble::tibble( - comparsion = "AFB=0 vs. AFB=1", + reference = "1", + comparison = "0", method = "Log-Rank", pval = 0.0009616214 ), @@ -118,9 +119,8 @@ test_that("s_get_survfit works as expected with specific time points", { tolerance = 0.0001 ) expect_equal( - res$surv_diff$rate[, c("group", "surv.diff", "lower", "upper", "pval")], + res$surv_diff$rate[, c("surv.diff", "lower", "upper", "pval")], tibble::tibble( - group = rep("AFB=0 vs. AFB=1", 3), surv.diff = c(0.09831085, 0.19007956, 0.21507329), lower = c(-0.01608841, 0.06331489, 0.07509421), upper = c(0.2127101, 0.3168442, 0.3550524), @@ -145,7 +145,8 @@ test_that("s_get_survfit works as expected with stratified variables", { expect_equal( res$surv_diff$test, tibble::tibble( - comparsion = "AFB=0 vs. AFB=1", + reference = "1", + comparison = "0", method = "Stratified Log-Rank", pval = 0.08269744 ), @@ -173,7 +174,7 @@ test_that("s_get_survfit works as expected with three groups when pairwise is TR ) expect_identical(dim(res$surv$median), c(3L, 6L)) expect_identical(dim(res$surv$quantile), c(6L, 5L)) - expect_identical(dim(res$surv$overall), c(188L, 9L)) + expect_identical(dim(res$surv$overall), c(445L, 9L)) expect_identical(dim(res$surv$range), c(3L, 7L)) }) @@ -190,7 +191,8 @@ test_that("s_get_coxph works as expected with default arguments", { expect_equal( res$hr, tibble::tibble( - comparsion = c("AFB=0 vs. AFB=1"), + reference = "1", + comparison = "0", n = 500, events = 215, hr = 0.5828995, @@ -202,7 +204,8 @@ test_that("s_get_coxph works as expected with default arguments", { expect_equal( res$pval, tibble::tibble( - comparsion = rep("AFB=0 vs. AFB=1", 3), + reference = rep("1", 3), + comparison = rep("0", 3), method = c("logtest", "sctest", "waldtest"), test = c(9.584563, 10.903404, 10.640000), df = c(1, 1, 1), @@ -225,9 +228,8 @@ test_that("s_get_coxph works as expected with stratification", { strata = c("AGE", "GENDER") ) expect_equal( - res$hr, + res$hr[, c(3:7)], tibble::tibble( - comparsion = c("AFB=0 vs. AFB=1"), n = 500, events = 215, hr = 0.6952678, @@ -237,9 +239,8 @@ test_that("s_get_coxph works as expected with stratification", { tolerance = 0.0001 ) expect_equal( - res$pval, + res$pval[, 3:6], tibble::tibble( - comparsion = rep("AFB=0 vs. AFB=1", 3), method = c("logtest", "sctest", "waldtest"), test = c(2.964049, 3.060662, 3.040000), df = c(1, 1, 1),