Merge pull request #66 from Merck/36-rpwenroll-rpw_enroll

36 rpwenroll rpw enroll

NAMESPACE

@@ -6,9 +6,8 @@ export(cutDataAtCount)
 export(fit_pwexp)
 export(getCutDateForCount)
 export(pMaxCombo)
-export(pMaxCombo)
+export(rpw_enroll)
 export(randomize_by_fixed_block)
-export(rpwenroll)
 export(rpwexp)
 export(rpwexpRcpp)
 export(rpwexpinvRcpp)

R/rpwenroll.R → R/rpw_enroll.R

@@ -23,7 +23,7 @@ NULL
 #' Generate Piecewise Exponential Enrollment
 #'
 #' With piecewise exponential enrollment rate generation any enrollment rate distribution can be easily approximated.
-#' \code{rpwenroll()} is to support simulation of both the Lachin and Foulkes (1986) sample size
+#' \code{rpw_enroll()} is to support simulation of both the Lachin and Foulkes (1986) sample size
 #' method for (fixed trial duration) as well as the Kim and Tsiatis(1990) method
 #' (fixed enrollment rates and either fixed enrollment duration or fixed minimum follow-up);
 #' see \code{\link[gsDesign:nSurv]{gsDesign}}.
@@ -41,7 +41,7 @@ NULL
 #' # Example 1
 #' # piecewise uniform (piecewise exponential inter-arrival times) for 10k patients enrollment
 #' # enrollment rates of 5 for time 0-100, 15 for 100-300, and 30 thereafter
-#' x <- rpwenroll(n = 1e5,
+#' x <- rpw_enroll(n = 1e5,
 #'                enrollRates = tibble(rate = c(5, 15, 30),
 #'                                     duration = c(100, 200, 100)))
 #' plot(x, 1:1e5,
@@ -51,15 +51,15 @@ NULL
 #'
 #' # Example 2
 #' # exponential enrollment
-#' x <- rpwenroll(n = 1e5,
+#' x <- rpw_enroll(n = 1e5,
 #'                enrollRates = tibble(rate = .03, duration = 1))
 #' plot(x, 1:1e5,
 #'      main = "Simulated exponential inter-arrival times",
 #'      xlab = "Time",
 #'      ylab = "Enrollment")
 #'
 #' @export
-rpwenroll <- function(n = NULL,
+rpw_enroll <- function(n = NULL,
                       enrollRates = tibble(duration = c(1, 2), rate = c(2, 5))
 ){
 
@@ -68,7 +68,7 @@ rpwenroll <- function(n = NULL,
   if(nrow(enrollRates) == 1) {
     # stop with error message if only 1 enrollment period and the enrollment rate is less or equal with 0
     if (enrollRates$rate <= 0){
-      stop("rpwenroll: please specify > 0 enrollment rate, otherwise enrollment cannot finish.")
+      stop("rpw_enroll: please specify > 0 enrollment rate, otherwise enrollment cannot finish.")
     }
     # otherwise, return inter-arrival exponential times
     else{
@@ -96,7 +96,7 @@ rpwenroll <- function(n = NULL,
 
     if (dplyr::last(enrollRates$rate) <= 0){
       # stop with error message if enrollment has not finished but enrollment rate for last period is less or equal with 0
-      stop("rpwenroll: please specify > 0 enrollment rate for the last period; otherwise enrollment cannot finish.")
+      stop("rpw_enroll: please specify > 0 enrollment rate for the last period; otherwise enrollment cannot finish.")
     }else{
       # otherwise, return inter-arrival exponential times
       ans <- cumsum(stats::rexp(n = n, rate = dplyr::last(enrollRates$rate))) + dplyr::last(y$finish)
@@ -124,7 +124,7 @@ rpwenroll <- function(n = NULL,
   n_add <- n - nrow(z)
   # stop with error message if enrollment has not finished but enrollment rate for last period is less or equal with 0
   if (dplyr::last(enrollRates$rate) <= 0){
-    stop("rpwenroll: please specify > 0 enrollment rate for the last period; otherwise enrollment cannot finish.")
+    stop("rpw_enroll: please specify > 0 enrollment rate for the last period; otherwise enrollment cannot finish.")
   }
   # Otherwise, return inter-arrival exponential times
   else{

R/simPWSurv.R

@@ -124,7 +124,7 @@ simPWSurv <- function(
                                size = n,
                                replace = TRUE,
                                prob = strata$p)) %>%
-    mutate(enrollTime = rpwenroll(n, enrollRates)) %>%
+    mutate(enrollTime = rpw_enroll(n, enrollRates)) %>%
     group_by(Stratum) %>%
     # assign treatment
     mutate(Treatment = randomize_by_fixed_block(n = n(), block = block)) %>%

_pkgdown.yml

@@ -37,7 +37,7 @@ reference:
     - rpwexp
     - rpwexpRcpp
     - rpwexpinvRcpp
-    - rpwenroll
+    - rpw_enroll
     - fit_pwexp
 - title: "Simulate data under the piecewise model"
   contents:

tests/testthat/test-independent_test_rpw_enroll.R

@@ -0,0 +1,22 @@
+test_that("rpw_enroll handles 0 enrollment rate properly for 1st enrollment period (with duration of 1 time unit)", {
+  n <- 50
+  enrollRates <- tibble(duration = c(1, 2), rate = c(0, 5))
+  x <- rpw_enroll(n=n, enrollRates=enrollRates)
+
+  expect_gt(x[1],enrollRates$duration[1])
+})
+
+test_that("rpw_enroll handles 0 enrollment rate properly for final enrollment period", {
+
+  set.seed(123)
+  n <- 50
+  enrollRates <- tibble(duration = c(1, 2), rate = c(10, 0))
+  expect_error(rpw_enroll(n=n, enrollRates=enrollRates))
+
+  n <- 5
+  enrollRates <- tibble(duration = 1, rate = 0)
+  expect_error(rpw_enroll(n=n, enrollRates=enrollRates))
+
+})
+
+

vignettes/simtrialroutines.Rmd

@@ -22,7 +22,7 @@ This vignette demonstrates the lower-level routines in the simtrial package spec
 The routines are as follows:
 
 * `randomize_by_fixed_block` - fixed block randomization
-* `rpwenroll` - random inter-arrival times with piecewise constant enrollment rates
+* `rpw_enroll` - random inter-arrival times with piecewise constant enrollment rates
 * `rpwexp` - piecewise exponential failure rate generation
 * `cutData` - cut data for analysis at a specified calendar time
 * `cutDataAtCount` - cut data for analysis at a specified event count, including ties on the cutoff date
@@ -67,7 +67,7 @@ randomize_by_fixed_block(n = 20)
 Piecewise constant enrollment can be randomly generated as follows. Note that duration is specifies interval durations for constant rates; the final rate is extended as long as needed to generate the specified number of observations.
 
 ```{r}
-rpwenroll(n = 20, enrollRates = tibble(
+rpw_enroll(n = 20, enrollRates = tibble(
   duration = c(1, 2),
   rate = c(2, 5)
 ))