Merge pull request #121 from jdblischak/MBdelayed

Update script to generate MBdelayed.rda

R/MBdelayed.R

@@ -28,7 +28,7 @@
 #' under the above scenario.
 #'
 #' @format
-#' A tibble with 200 rows and xx columns:
+#' A tibble with 200 rows and 4 columns:
 #' - `tte`: Time to event.
 #'
 #' @references

R/sim_pw_surv.R

@@ -142,6 +142,13 @@ sim_pw_surv <- function(
       duration = rep(100, 2),
       rate = rep(.001, 2)
     )) {
+  # Enforce consistent treatment names
+  treatments <- unique(c(block, fail_rate$treatment, dropout_rate$treatment))
+  stopifnot(
+    treatments %in% block,
+    treatments %in% fail_rate$treatment,
+    treatments %in% dropout_rate$treatment
+  )
   # Start table by generating stratum and enrollment times
   x <- data.table(stratum = sample(
     x = stratum$stratum,

data-raw/DATASET.R

@@ -1,22 +1,24 @@
-## code to prepare `DATASET` dataset goes here
+## code to prepare `MBdelayed` dataset goes here
+library(simtrial)
 library(tibble)
 set.seed(6671)
-ds <- simPWSurv(
+ds <- sim_pw_surv(
   n = 200,
-  enrollRates = tibble(rate = 200 / 12, duration = 12),
-  failRates = tribble(
-    ~Stratum, ~Period, ~Treatment, ~duration, ~rate,
-    "All", 1, "Control", 42, log(2) / 15,
-    "All", 1, "Experimental", 6, log(2) / 15,
-    "All", 2, "Experimental", 36, log(2) / 15 * 0.6
+  block = c(rep("control", 2), rep("experimental", 2)),
+  enroll_rate = tibble(rate = 200 / 12, duration = 12),
+  fail_rate = tribble(
+    ~stratum, ~period, ~treatment, ~duration, ~rate,
+    "All", 1, "control", 42, log(2) / 15,
+    "All", 1, "experimental", 6, log(2) / 15,
+    "All", 2, "experimental", 36, log(2) / 15 * 0.6
   ),
-  dropoutRates = tribble(
-    ~Stratum, ~Period, ~Treatment, ~duration, ~rate,
-    "All", 1, "Control", 42, 0,
-    "All", 1, "Experimental", 42, 0
+  dropout_rate = tribble(
+    ~stratum, ~period, ~treatment, ~duration, ~rate,
+    "All", 1, "control", 42, 0,
+    "All", 1, "experimental", 42, 0
   )
 )
 # cut data at 24 months after final enrollment
-MBdelayed <- ds %>% cutData(max(ds$enrollTime) + 24)
+MBdelayed <- ds %>% cut_data_by_date(max(ds$enroll_time) + 24)
 
-usethis::use_data("MBdelayed")
+usethis::use_data(MBdelayed, overwrite = TRUE)

tests/testthat/test-double_programming_simPWSurv.R

@@ -127,3 +127,30 @@ zevent <- dplyr::bind_rows(rate00, rate01, rate10, rate11)
 testthat::test_that("The actual number of events changes by changing total sample size", {
   expect_false(unique(xevent$event == zevent$event))
 })
+
+testthat::test_that("sim_pw_surv() fails early with mismatched treatment names", {
+  block <- c(rep("x", 2), rep("y", 2))
+  fail_rate <- data.frame(
+    stratum = rep("All", 4),
+    period = rep(1:2, 2),
+    treatment = c(rep("x", 2), rep("y", 2)),
+    duration = rep(c(3, 1), 2),
+    rate = log(2) / c(9, 9, 9, 18)
+  )
+  dropout_rate <- data.frame(
+    stratum = rep("All", 2),
+    period = rep(1, 2),
+    treatment = c("x", "y"),
+    duration = rep(100, 2),
+    rate = rep(0.001, 2)
+  )
+
+  expect_error(sim_pw_surv(block = block))
+  expect_error(sim_pw_surv(fail_rate = fail_rate))
+  expect_error(sim_pw_surv(dropout_rate = dropout_rate))
+  # works as long as treatment names are consistent
+  expect_silent(
+    xy <- sim_pw_surv(block = block, fail_rate = fail_rate, dropout_rate = dropout_rate)
+  )
+  expect_identical(sort(unique(xy$treatment)), c("x", "y"))
+})