From fd47572aca3e65b2fcf51f0e1f5ae7e379e151f1 Mon Sep 17 00:00:00 2001 From: Kai Gu Date: Wed, 8 May 2024 14:49:18 +0800 Subject: [PATCH 1/2] fix issue #27 in print method of s_get_survfit --- R/count_event.R | 6 ++++-- R/pkg-methods.R | 32 +++++++++++++++++-------------- R/summarize-survival.R | 6 ++++-- man/s_count_event.Rd | 6 ++++-- man/s_get_survfit.Rd | 3 +++ tests/spelling.R | 9 ++++++--- tests/testthat/test-pkg-methods.R | 1 - 7 files changed, 39 insertions(+), 24 deletions(-) diff --git a/R/count_event.R b/R/count_event.R index 79fb1bb..8a89869 100644 --- a/R/count_event.R +++ b/R/count_event.R @@ -42,8 +42,10 @@ #' "SAE" = c("AESER" = "Y"), #' "TRSAE" = c("AESER" = "Y", "AEREL" = "Y") #' ), -#' label = c("Any TEAEs", "Any treatment-related TEAEs", -#' "Any serious TEAEs", "Any serious treatment-related TEAEs"), +#' label = c( +#' "Any TEAEs", "Any treatment-related TEAEs", +#' "Any serious TEAEs", "Any serious treatment-related TEAEs" +#' ), #' denom = rand_adsl #' ) #' diff --git a/R/pkg-methods.R b/R/pkg-methods.R index 87f1435..6bc5852 100644 --- a/R/pkg-methods.R +++ b/R/pkg-methods.R @@ -261,9 +261,9 @@ print.s_survival <- function(x, fm = "months", ...) { 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) + ) + # ind <- grep(df[[.var]][1], row.names(surv_med), fixed = TRUE) + ind <- which(surv_med$group == df[[.var]][1]) in_rows( "Number of events" = rcell( surv_med$events[ind] * c(1, 1 / .N_col), @@ -277,8 +277,7 @@ print.s_survival <- function(x, fm = "months", ...) { } a_surv_time_func <- function(df, .var, res) { - med_tb <- res$surv$median %>% - tibble::column_to_rownames(var = "group") + med_tb <- res$surv$median quant_tb <- res$surv$quantile %>% tidyr::pivot_longer(cols = -c(1, 2), values_to = "Value", names_to = "Stat") %>% tidyr::pivot_wider( @@ -286,15 +285,17 @@ print.s_survival <- function(x, fm = "months", ...) { 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) + ) + range_tb <- res$surv$range + # ind <- grep(df[[.var]][1], row.names(med_tb), fixed = TRUE) + ind <- which(med_tb$group == df[[.var]][1]) med_time <- list(med_tb[ind, c("median", "lower", "upper")]) quantile_time <- lapply(c(res$params$quantile * 100), function(x) { + ind <- which(quant_tb$group == df[[.var]][1]) unlist(c(quant_tb[ind, grep(paste0("Q", x), names(quant_tb))])) }) + # ind <- grep(df[[.var]][1], row.names(range_tb), fixed = TRUE) + ind <- which(range_tb$group == df[[.var]][1]) range_time <- list(range_tb[ind, c("min", "max")]) in_rows( .list = c(med_time, quantile_time, range_time), @@ -355,7 +356,8 @@ print.s_survival <- function(x, fm = "months", ...) { 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) + # ind <- grep(df[[.var]][1], row.names(rate_tb), fixed = TRUE) + ind <- which(row.names(rate_tb) == df[[.var]][1]) in_rows( rcell(rate_tb[ind, "n.risk", drop = TRUE], format = "xx"), rcell(rate_tb[ind, "surv", drop = TRUE], format = "xx.xxx"), @@ -519,9 +521,11 @@ print.count_evt <- function(x, ...) { split_cols_by(grp_var) for (i in seq_along(labels)) { tbl <- tbl %>% - analyze(grp_var, a_evt_func, show_labels = "hidden", - extra_args = list(cnt_tb = x$cnt, lab = labels[i]), - table_names = labels[i]) + analyze(grp_var, a_evt_func, + show_labels = "hidden", + extra_args = list(cnt_tb = x$cnt, lab = labels[i]), + table_names = labels[i] + ) } result <- tbl %>% build_table(df = x$data, col_counts = x$params$denom) diff --git a/R/summarize-survival.R b/R/summarize-survival.R index 6d89cd5..9e7b31a 100644 --- a/R/summarize-survival.R +++ b/R/summarize-survival.R @@ -25,6 +25,7 @@ #' of comparing survival curves. Default is 0 that is log-rank , others options #' can see [survival::survdiff()]. #' @param pairwise (`logical`)\cr whether to conduct the pairwise comparison. +#' @param survdiff (`logical`)\cr whether to test survival curve differences. #' @param ... other arguments to be passed to [survival::survfit()]. #' #' @order 1 @@ -120,6 +121,7 @@ s_get_survfit <- function(data, strata = NULL, rho = 0, pairwise = FALSE, + survdiff = TRUE, ...) { assert_class(data, "data.frame") assert_formula(formula) @@ -158,7 +160,7 @@ s_get_survfit <- function(data, } }) %>% purrr::list_rbind() %>% - tidyr::pivot_longer(cols = dplyr::contains(grps), names_to = "group") %>% + tidyr::pivot_longer(tidyr::everything(), names_to = "group") %>% mutate( group = sub(paste0(grp_var, "="), "", .data$group), type = rep(c("time", "lower", "upper"), each = length(quantile) * length(grps)), @@ -235,7 +237,7 @@ s_get_survfit <- function(data, } # test survival curves - surv_test <- if (!is.null(km_fit$strata)) { + surv_test <- if (!is.null(km_fit$strata) & survdiff) { survdiff <- h_pairwise_survdiff( formula = formula, strata = strata, diff --git a/man/s_count_event.Rd b/man/s_count_event.Rd index 7cc57b4..6d1bd63 100644 --- a/man/s_count_event.Rd +++ b/man/s_count_event.Rd @@ -63,8 +63,10 @@ s_count_event( "SAE" = c("AESER" = "Y"), "TRSAE" = c("AESER" = "Y", "AEREL" = "Y") ), - label = c("Any TEAEs", "Any treatment-related TEAEs", - "Any serious TEAEs", "Any serious treatment-related TEAEs"), + label = c( + "Any TEAEs", "Any treatment-related TEAEs", + "Any serious TEAEs", "Any serious treatment-related TEAEs" + ), denom = rand_adsl ) diff --git a/man/s_get_survfit.Rd b/man/s_get_survfit.Rd index 916beb9..475e9e5 100644 --- a/man/s_get_survfit.Rd +++ b/man/s_get_survfit.Rd @@ -17,6 +17,7 @@ s_get_survfit( strata = NULL, rho = 0, pairwise = FALSE, + survdiff = TRUE, ... ) @@ -50,6 +51,8 @@ can see \code{\link[survival:survdiff]{survival::survdiff()}}.} \item{pairwise}{(\code{logical})\cr whether to conduct the pairwise comparison.} +\item{survdiff}{(\code{logical})\cr whether to test survival curve differences.} + \item{...}{other arguments to be passed to \code{\link[survival:survfit]{survival::survfit()}}.} \item{fm}{(\code{string})\cr string of unit for survival time.} diff --git a/tests/spelling.R b/tests/spelling.R index 6713838..13f77d9 100644 --- a/tests/spelling.R +++ b/tests/spelling.R @@ -1,3 +1,6 @@ -if(requireNamespace('spelling', quietly = TRUE)) - spelling::spell_check_test(vignettes = TRUE, error = FALSE, - skip_on_cran = TRUE) +if (requireNamespace("spelling", quietly = TRUE)) { + spelling::spell_check_test( + vignettes = TRUE, error = FALSE, + skip_on_cran = TRUE + ) +} diff --git a/tests/testthat/test-pkg-methods.R b/tests/testthat/test-pkg-methods.R index dfc5e60..7bb5749 100644 --- a/tests/testthat/test-pkg-methods.R +++ b/tests/testthat/test-pkg-methods.R @@ -189,4 +189,3 @@ test_that("print.count_evt works as expected", { expect_match(res2, "Total", fixed = TRUE) expect_match(res2, "(N=200)", fixed = TRUE) }) - From 9be536e01bcb0d11e7368e0eb33da1db86fb8499 Mon Sep 17 00:00:00 2001 From: Kai Gu Date: Wed, 8 May 2024 14:55:46 +0800 Subject: [PATCH 2/2] add event count section in readme --- README.Rmd | 3 ++- README.md | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/README.Rmd b/README.Rmd index 109f15f..e5b33b2 100644 --- a/README.Rmd +++ b/README.Rmd @@ -23,7 +23,7 @@ The goal of `stabiot` is to assist statisticians and statistical programmers in trials. The data sets would be ADaM format preferably, but they do not have to strictly follow the CDISC standards. -To guarantee accurate results, I prefer to wrap mature R package rather than rebuild statistical methods. Parts of statistics outputs are styled with `rtables`. For present, the completed sections are listed below. +To guarantee accurate results, I prefer to wrap mature R packages rather than rebuild statistical methods. Parts of statistics outputs are styled with `rtables`. For present, the completed sections are listed below. - Simulation of sample size determination by Bayesian. - Summarize Least-squares Means from models, such as ANCOVA and MMRM. @@ -31,6 +31,7 @@ To guarantee accurate results, I prefer to wrap mature R package rather than reb confidence interval. - Derive best overall response (confirmed or not confirmed BOR) per RECIST 1.1. - Summarize survival analyses using `survival` package. +- Count number of events (AE overview). ## Installation diff --git a/README.md b/README.md index a9c6b8b..e32644b 100644 --- a/README.md +++ b/README.md @@ -14,7 +14,7 @@ produced by SAS from outsourcing in clinical trials. The data sets would be ADaM format preferably, but they do not have to strictly follow the CDISC standards. -To guarantee accurate results, I prefer to wrap mature R package rather +To guarantee accurate results, I prefer to wrap mature R packages rather than rebuild statistical methods. Parts of statistics outputs are styled with `rtables`. For present, the completed sections are listed below. @@ -25,6 +25,7 @@ with `rtables`. For present, the completed sections are listed below. - Derive best overall response (confirmed or not confirmed BOR) per RECIST 1.1. - Summarize survival analyses using `survival` package. +- Count number of events (AE overview). ## Installation