Convert wlr() to S3 generic to accept tte_data or counting_process

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: simtrial
 Type: Package
 Title: Clinical Trial Simulation
-Version: 0.4.1.8
+Version: 0.4.1.9
 Authors@R: c(
     person("Keaven", "Anderson", email = "[email protected]", role = c("aut")),
     person("Yujie", "Zhao", email = "[email protected]", role =  c("ctb","cre")),

NAMESPACE

@@ -1,5 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(wlr,counting_process)
+S3method(wlr,default)
+S3method(wlr,tte_data)
 export(counting_process)
 export(create_cut)
 export(create_test)

R/cut_data_by_date.R

@@ -40,5 +40,6 @@ cut_data_by_date <- function(x, cut_date) {
   ans <- ans[, c("tte", "event", "stratum", "treatment")]
 
   setDF(ans)
+  class(ans) <- c("tte_data", class(ans))
   return(ans)
 }

R/cut_data_by_event.R

@@ -36,5 +36,6 @@
 cut_data_by_event <- function(x, event) {
   cut_date <- get_cut_date_by_event(x, event)
   ans <- x |> cut_data_by_date(cut_date = cut_date)
+  class(ans) <- c("tte_data", class(ans))
   return(ans)
 }

R/wlr.R

@@ -18,7 +18,8 @@
 
 #' Weighted logrank test
 #'
-#' @param data Dataset that has been cut, generated by [sim_pw_surv()].
+#' @param data Dataset (generated by [sim_pw_surv()]) that has been cut by
+#'   [counting_process()], [cut_data_by_date()], or [cut_data_by_event()].
 #' @param weight Weighting functions, such as [fh()], [mb()], and
 #'   [early_zero()].
 #' @param return_variance A logical flag that, if `TRUE`, adds columns
@@ -85,8 +86,34 @@
 #'
 #' # Example 3: WLR test with early zero wights
 #' x |> wlr(weight = early_zero(early_period = 4))
+#'
+#' # For increased computational speed when running many WLR tests, you can
+#' # pre-compute the counting_process() step first, and then pass the result of
+#' # counting_process() directly to wlr()
+#' x <- x |> counting_process(arm = "experimental")
+#' x |> wlr(weight = fh(rho = 0, gamma = 1))
+#' x |> wlr(weight = mb(delay = 4, w_max = 2))
+#' x |> wlr(weight = early_zero(early_period = 4))
 wlr <- function(data, weight, return_variance = FALSE) {
+  UseMethod("wlr", data)
+}
+
+#' @rdname wlr
+#' @export
+wlr.counting_process <- function(data, weight, return_variance = FALSE) {
+  wlr.default(data, weight, return_variance = FALSE)
+}
+
+#' @rdname wlr
+#' @export
+wlr.tte_data <- function(data, weight, return_variance = FALSE) {
   x <- data |> counting_process(arm = "experimental")
+  wlr.default(x, weight, return_variance = FALSE)
+}
+
+#' @export
+wlr.default <- function(data, weight, return_variance = FALSE) {
+  x <- data
 
   ans <- list()
   ans$method <- "WLR"

tests/testthat/test-unvalidated-data.table.R

@@ -12,7 +12,7 @@ test_that("functions that use data.table still return a data frame", {
 
   # cut_data_by_date()
   x <- sim_pw_surv(n = 20)
-  expect_identical(class(cut_data_by_date(x, 5)), class_expected)
+  expect_identical(class(cut_data_by_date(x, 5)), c("tte_data", class_expected))
 
   # early_zero_weight()
   x <- sim_pw_surv(n = 200)

tests/testthat/test-unvalidated-wlr.R

@@ -0,0 +1,23 @@
+test_that("wlr() accepts tte_data and counting_process objects as input", {
+  # cut_data_by_event()
+  x <- sim_pw_surv(n = 300) |> cut_data_by_event(100)
+  expect_s3_class(x, "tte_data")
+  results_tte_data <- x |> wlr(weight = fh(0, 0.5))
+
+  x <- x |> counting_process(arm = "experimental")
+  expect_s3_class(x, "counting_process")
+  results_counting_process <- x |> wlr(weight = fh(0, 0.5))
+
+  expect_equal(results_tte_data, results_counting_process)
+
+  # cut_data_by_date()
+  x <- sim_pw_surv(n = 300) |> cut_data_by_date(cut_date = 300)
+  expect_s3_class(x, "tte_data")
+  results_tte_data <- x |> wlr(weight = fh(0, 0.5))
+
+  x <- x |> counting_process(arm = "experimental")
+  expect_s3_class(x, "counting_process")
+  results_counting_process <- x |> wlr(weight = fh(0, 0.5))
+
+  expect_equal(results_tte_data, results_counting_process)
+})