From 4255ae02cd2334203a6b8ced0c93c590b290722a Mon Sep 17 00:00:00 2001 From: "Ling, Li Li" Date: Tue, 21 Feb 2023 23:41:31 -0500 Subject: [PATCH 1/4] rpwenroll to rpw_enroll --- R/{rpwenroll.R => rpw_enroll.R} | 14 ++++++------ _pkgdown.yml | 2 +- .../test-independent_test_rpw_enroll.R | 22 +++++++++++++++++++ .../test-independent_test_rpwenroll.R | 22 ------------------- 4 files changed, 30 insertions(+), 30 deletions(-) rename R/{rpwenroll.R => rpw_enroll.R} (90%) create mode 100644 tests/testthat/test-independent_test_rpw_enroll.R delete mode 100644 tests/testthat/test-independent_test_rpwenroll.R diff --git a/R/rpwenroll.R b/R/rpw_enroll.R similarity index 90% rename from R/rpwenroll.R rename to R/rpw_enroll.R index f4c58f11..48e66d45 100644 --- a/R/rpwenroll.R +++ b/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,7 +51,7 @@ 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", @@ -59,7 +59,7 @@ NULL #' 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{ diff --git a/_pkgdown.yml b/_pkgdown.yml index 74f62c51..961f7472 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -37,7 +37,7 @@ reference: - rpwexp - rpwexpRcpp - rpwexpinvRcpp - - rpwenroll + - rpw_enroll - pwexpfit - title: "Simulate data under the piecewise model" contents: diff --git a/tests/testthat/test-independent_test_rpw_enroll.R b/tests/testthat/test-independent_test_rpw_enroll.R new file mode 100644 index 00000000..18ccf66a --- /dev/null +++ b/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)) + +}) + + diff --git a/tests/testthat/test-independent_test_rpwenroll.R b/tests/testthat/test-independent_test_rpwenroll.R deleted file mode 100644 index 0e1b6b65..00000000 --- a/tests/testthat/test-independent_test_rpwenroll.R +++ /dev/null @@ -1,22 +0,0 @@ -test_that("rpwenroll 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 <- rpwenroll(n=n, enrollRates=enrollRates) - - expect_gt(x[1],enrollRates$duration[1]) -}) - -test_that("rpwenroll 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(rpwenroll(n=n, enrollRates=enrollRates)) - - n <- 5 - enrollRates <- tibble(duration = 1, rate = 0) - expect_error(rpwenroll(n=n, enrollRates=enrollRates)) - -}) - - From 7f870166cfc5a2e7d9207fd9d2d6501f0061c744 Mon Sep 17 00:00:00 2001 From: "Ling, Li Li" Date: Tue, 21 Feb 2023 23:42:53 -0500 Subject: [PATCH 2/4] run devtools::document() --- DESCRIPTION | 2 +- NAMESPACE | 2 +- man/{rpwenroll.Rd => rpw_enroll.Rd} | 14 +++++++------- 3 files changed, 9 insertions(+), 9 deletions(-) rename man/{rpwenroll.Rd => rpw_enroll.Rd} (82%) diff --git a/DESCRIPTION b/DESCRIPTION index 02797e17..2c5627e4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -53,7 +53,7 @@ Suggests: Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 +RoxygenNote: 7.2.3 VignetteBuilder: knitr Remotes: dominicmagirr/modestWLRT diff --git a/NAMESPACE b/NAMESPACE index 21e1adb9..d432e875 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,7 @@ export(fixedBlockRand) export(getCutDateForCount) export(pMaxCombo) export(pwexpfit) -export(rpwenroll) +export(rpw_enroll) export(rpwexp) export(rpwexpRcpp) export(rpwexpinvRcpp) diff --git a/man/rpwenroll.Rd b/man/rpw_enroll.Rd similarity index 82% rename from man/rpwenroll.Rd rename to man/rpw_enroll.Rd index bc3332f0..a67f9e3c 100644 --- a/man/rpwenroll.Rd +++ b/man/rpw_enroll.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/rpwenroll.R -\name{rpwenroll} -\alias{rpwenroll} +% Please edit documentation in R/rpw_enroll.R +\name{rpw_enroll} +\alias{rpw_enroll} \title{Generate Piecewise Exponential Enrollment} \usage{ -rpwenroll(n = NULL, enrollRates = tibble(duration = c(1, 2), rate = c(2, 5))) +rpw_enroll(n = NULL, enrollRates = tibble(duration = c(1, 2), rate = c(2, 5))) } \arguments{ \item{n}{Number of observations. @@ -19,7 +19,7 @@ A vector of random enrollment times. } \description{ 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}}. @@ -29,7 +29,7 @@ library(tibble) # 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, @@ -39,7 +39,7 @@ plot(x, 1:1e5, # 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", From 2566a7a3b55add798d6fcc8d9a0421e5cfa6981b Mon Sep 17 00:00:00 2001 From: "Ling, Li Li" Date: Tue, 21 Feb 2023 23:58:41 -0500 Subject: [PATCH 3/4] rpwenroll to rpw_enroll --- R/simPWSurv.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/simPWSurv.R b/R/simPWSurv.R index b49fa046..4cec66c9 100644 --- a/R/simPWSurv.R +++ b/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 = fixedBlockRand(n = n(), block = block)) %>% From 450edb7c7337db8e80b0df33826a6f622987a63c Mon Sep 17 00:00:00 2001 From: "Ling, Li Li" Date: Wed, 22 Feb 2023 00:10:34 -0500 Subject: [PATCH 4/4] rpwenroll to rpw_enroll --- vignettes/simtrialroutines.Rmd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/vignettes/simtrialroutines.Rmd b/vignettes/simtrialroutines.Rmd index 8b5077b9..5f23930e 100644 --- a/vignettes/simtrialroutines.Rmd +++ b/vignettes/simtrialroutines.Rmd @@ -22,7 +22,7 @@ This vignette demonstrates the lower-level routines in the simtrial package spec The routines are as follows: * `fixedBlockRand` - 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 @@ fixedBlockRand(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) ))