Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

36 rpwenroll rpw enroll #66

Merged
merged 5 commits into from
Feb 27, 2023
Merged
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ export(fixedBlockRand)
export(getCutDateForCount)
export(pMaxCombo)
export(pwexpfit)
export(rpwenroll)
export(rpw_enroll)
export(rpwexp)
export(rpwexpRcpp)
export(rpwexpinvRcpp)
Expand Down
14 changes: 7 additions & 7 deletions R/rpwenroll.R → R/rpw_enroll.R
Original file line number Diff line number Diff line change
Expand Up @@ -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}}.
Expand All @@ -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,
Expand All @@ -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))
){

Expand All @@ -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{
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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{
Expand Down
2 changes: 1 addition & 1 deletion R/simPWSurv.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)) %>%
Expand Down
2 changes: 1 addition & 1 deletion _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -37,7 +37,7 @@ reference:
- rpwexp
- rpwexpRcpp
- rpwexpinvRcpp
- rpwenroll
- rpw_enroll
- pwexpfit
- title: "Simulate data under the piecewise model"
contents:
Expand Down
14 changes: 7 additions & 7 deletions man/rpwenroll.Rd → man/rpw_enroll.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

22 changes: 22 additions & 0 deletions tests/testthat/test-independent_test_rpw_enroll.R
Original file line number Diff line number Diff line change
@@ -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))

})


22 changes: 0 additions & 22 deletions tests/testthat/test-independent_test_rpwenroll.R

This file was deleted.

4 changes: 2 additions & 2 deletions vignettes/simtrialroutines.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)
))
Expand Down