Fix issue in print method of s_get_survfit

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
 #' )
 #'

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,24 +277,25 @@ 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(
         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)
+      )
+    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)

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,

README.Rmd

@@ -23,14 +23,15 @@ 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.
 - Compute response rate, odds ratio with or without stratification, and corresponding 
 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
 

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
 

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
+  )
+}

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)
 })
-