diff --git a/R/MBdelayed.R b/R/MBdelayed.R index ef50c913..dab61fc9 100644 --- a/R/MBdelayed.R +++ b/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 diff --git a/R/sim_pw_surv.R b/R/sim_pw_surv.R index a9c604fc..6d4b3a69 100644 --- a/R/sim_pw_surv.R +++ b/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, diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R index da826a7d..ea010c70 100644 --- a/data-raw/DATASET.R +++ b/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) diff --git a/data/MBdelayed.rda b/data/MBdelayed.rda index 5716c95e..9a8f42b9 100644 Binary files a/data/MBdelayed.rda and b/data/MBdelayed.rda differ diff --git a/man/MBdelayed.Rd b/man/MBdelayed.Rd index 80aefd31..0b665203 100644 --- a/man/MBdelayed.Rd +++ b/man/MBdelayed.Rd @@ -5,7 +5,7 @@ \alias{MBdelayed} \title{Simulated survival dataset with delayed treatment effect} \format{ -A tibble with 200 rows and xx columns: +A tibble with 200 rows and 4 columns: \itemize{ \item \code{tte}: Time to event. } diff --git a/tests/testthat/test-double_programming_simPWSurv.R b/tests/testthat/test-double_programming_simPWSurv.R index ef7fa4d6..d8460b62 100644 --- a/tests/testthat/test-double_programming_simPWSurv.R +++ b/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")) +})