Merge pull request #281 from Merck/279-get-ratio-as-an-attributes-of-…

…sim_pw_surv-and-pass-it-to-wlr

Get `ratio` as an attributes of `sim_pw_surv` and pass it to `wlr`

R/counting_process.R

@@ -147,10 +147,15 @@ counting_process <- function(x, arm) {
 
   setDF(ans)
   class(ans) <- c("counting_process", class(ans))
-  # Record number of control and experimental treatments, which is required for
-  # downstream test function wlr()
-  attr(ans, "n_ctrl") <- sum(x$treatment == "control")
-  attr(ans, "n_exp") <- sum(x$treatment == "experimental")
+
+  # if `x` is generated by sim_pw_surv
+  if ("generate_by_simpwsurv" %in% names(attributes(x))) {
+    ratio <- attributes(x)$ratio
+  } else {
+  # if not, calcualte the emperical ratio
+    ratio <- sum(x$treatment == arm) / sum(x$treatment != arm)
+  }
+  attr(ans, "ratio") <- ratio
 
   return(ans)
 }

R/cut_data_by_date.R

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

R/cut_data_by_event.R

@@ -36,6 +36,8 @@
 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)
+
+  attr(ans, "ratio") <- attributes(x)$ratio
   class(ans) <- c("tte_data", class(ans))
   return(ans)
 }

R/sim_pw_surv.R

@@ -191,5 +191,9 @@ sim_pw_surv <- function(
   ans[, fail := (fail_time <= dropout_time) * 1]
 
   setDF(ans)
+
+  attr(ans, "ratio") <- sum(block == "experimental") / sum(block == "control")
+  attr(ans, "generate_by_simpwsurv") <- "yes"
+
   return(ans)
 }

R/wlr.R

@@ -25,6 +25,17 @@
 #' @param return_variance A logical flag that, if `TRUE`, adds columns
 #'   estimated variance for weighted sum of observed minus expected;
 #'   see details; Default: `FALSE`.
+#' @param ratio randomization ratio (experimental:control).
+#'  - If the `data` is generated by simtrial, such as
+#'    + `data = sim_pw_surv(...) |> cut_data_by_date(...)`
+#'    + `data = sim_pw_surv(...) |> cut_data_by_event(...)`
+#'    + `data = sim_pw_surv(...) |> cut_data_by_date(...) |> counting_process(...)`
+#'    + `data = sim_pw_surv(...) |> cut_data_by_event(...) |> counting_process(...)`
+#'   there is no need to input the `ratio`, as simtrial gets the `ratio` via the
+#'   `block` arguments in [sim_pw_surv()].
+#'  - If the `data` is a custom dataset (see Example 2) below,
+#'    + Users are suggested to input the planned randomization ratio to `ratio`;
+#'    + If not, simtrial takes the empirical randomization ratio.
 #'
 #' @return A list containing the test method (`method`),
 #' parameters of this test method (`parameter`),
@@ -75,44 +86,86 @@
 #'   \deqn{z = \sum_i X_i/\sqrt{\sum_i V_i}.}
 #'
 #' @examples
+#' # ---------------------- #
+#' #      Example 1         #
+#' #  Use dataset generated #
+#' #     by simtrial        #
+#' # ---------------------- #
 #' x <- sim_pw_surv(n = 200) |> cut_data_by_event(100)
 #'
-#' # Example 1: WLR test with FH wights
+#' # Example 1A: WLR test with FH wights
 #' x |> wlr(weight = fh(rho = 0, gamma = 0.5))
 #' x |> wlr(weight = fh(rho = 0, gamma = 0.5), return_variance = TRUE)
 #'
-#' # Example 2: WLR test with MB wights
+#' # Example 1B: WLR test with MB wights
 #' x |> wlr(weight = mb(delay = 4, w_max = 2))
 #'
-#' # Example 3: WLR test with early zero wights
+#' # Example 1C: WLR test with early zero wights
 #' x |> wlr(weight = early_zero(early_period = 4))
 #'
+#' # Example 1D
 #' # 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) {
+#'
+#' # ---------------------- #
+#' #      Example 2         #
+#' #  Use cumsum dataset    #
+#' # ---------------------- #
+#' x <- data.frame(treatment = ifelse(ex1_delayed_effect$trt == 1, "experimental", "control"),
+#'                 stratum = rep("All", nrow(ex1_delayed_effect)),
+#'                 tte = ex1_delayed_effect$month,
+#'                 event = ex1_delayed_effect$evntd)
+#' class(x) <- c("tte_data", class(x))
+#'
+#' # Users can specify the randomization ratio to calculate the statistical information under H0
+#' x |> wlr(weight = fh(rho = 0, gamma = 0.5), ratio = 2)
+#'
+#' x |>
+#'   counting_process(arm = "experimental") |>
+#'   wlr(weight = fh(rho = 0, gamma = 0.5), ratio = 2)
+#'
+#' # If users don't provide the randomization ratio, we will calculate the emperical ratio
+#' x |> wlr(weight = fh(rho = 0, gamma = 0.5))
+#'
+#' x |>
+#'   counting_process(arm = "experimental") |>
+#'   wlr(weight = fh(rho = 0, gamma = 0.5))
+wlr <- function(data, weight, return_variance = FALSE, ratio = NULL) {
   UseMethod("wlr", data)
 }
 
 #' @rdname wlr
 #' @export
-wlr.tte_data <- function(data, weight, return_variance = FALSE) {
+wlr.tte_data <- function(data, weight, return_variance = FALSE, ratio = NULL) {
+  # if the `data` is NOT generated by sim_pw_surv
+  # - if user input the randomization ratio, we will directly take its values
+  # - otherwise, we calculate the empirical ratio
+  if (!"generate_by_simpwsurv" %in% names(attributes(data))) {
+    if (is.null(ratio)) {
+      ratio <- sum(data$treatment == "experimental") / sum(data$treatment == "control")
+    }
+  } else {
+  # if the `data` is generated by sim_pw_surv, the take the ratio from the attributes of `data`
+    ratio <- attributes(data)$ratio
+  }
+
   x <- data |> counting_process(arm = "experimental")
-  wlr.counting_process(x, weight, return_variance = FALSE)
+  wlr.counting_process(x, weight, return_variance = FALSE, ratio = ratio)
 }
 
 #' @rdname wlr
 #' @export
-wlr.counting_process <- function(data, weight, return_variance = FALSE) {
+wlr.counting_process <- function(data, weight, return_variance = FALSE, ratio = NULL) {
   x <- data
 
-  # calculate the sample size and randomization ratio
-  n <- nrow(data)
-  ratio <- attr(data, "n_exp") / attr(data, "n_ctrl")
+  if (is.null(ratio)) {
+    ratio <- attributes(data)$ratio
+  }
   q_e <- ratio / (1 + ratio)
   q_c <- 1 - q_e