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

Rename function factories create_cut() and create_test() #221

Merged
merged 5 commits into from
Mar 25, 2024
Merged
Show file tree
Hide file tree
Changes from all 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
@@ -1,7 +1,7 @@
Package: simtrial
Type: Package
Title: Clinical Trial Simulation
Version: 0.3.2.13
Version: 0.3.2.14
Authors@R: c(
person("Keaven", "Anderson", email = "keaven_anderson@merck.com", role = c("aut")),
person("Yilong", "Zhang", email = "elong0527@gmail.com", role = c("aut")),
Expand Down
4 changes: 2 additions & 2 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
# Generated by roxygen2: do not edit by hand

export(counting_process)
export(create_cutting)
export(create_cutting_test)
export(create_cut)
export(create_test)
export(cut_data_by_date)
export(cut_data_by_event)
export(early_zero)
Expand Down
74 changes: 38 additions & 36 deletions R/sim_gs_n.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,17 +22,19 @@
#' arguments will change as we add additional features.
#'
#' @inheritParams sim_fixed_n
#' @param test A test function such as [wlr()], [maxcombo()], or [rmst()]. The
#' simulated data set is passed as the first positional argument to the test
#' function provided. Alternatively a list of functions created by
#' [create_cutting_test()]. The list form is experimental and currently
#' limited. It only accepts one test per cutting (in the future multiple tests
#' may be accepted), and all the tests must consistently return the same exact
#' results (again this may be more flexible in the future).
#' @param cutting A list of cutting functions created by [create_cutting()],
#' see examples.
#' @param test One or more test functions such as [wlr()], [maxcombo()], or
#' [rmst()]. If a single test function is provided, it will be applied at each
#' cut. Alternatively a list of functions created by [create_test()]. The list
#' form is experimental and currently limited. It only accepts one test per
#' cutting (in the future multiple tests may be accepted), and all the tests
#' must consistently return the same exact results (again this may be more
#' flexible in the future). Importantly, note that the simulated data set is
#' always passed as the first positional argument to each test function
#' provided.
#' @param cut A list of cutting functions created by [create_cut()], see
#' examples.
#' @param seed Random seed.
#' @param ... Arguments passed to the test function provided by the argument
#' @param ... Arguments passed to the test function(s) provided by the argument
#' `test`.
#'
#' @return A data frame summarizing the simulation ID, analysis date,
Expand Down Expand Up @@ -79,7 +81,7 @@
#' # - At least 20 months have elapsed after enrolling 200/400 subjects, with a
#' # minimum of 20 months follow-up.
#' # However, if events accumulation is slow, we will wait for a maximum of 24 months.
#' ia1 <- create_cutting(
#' ia1 <- create_cut(
#' planned_calendar_time = 20,
#' target_event_overall = 100,
#' max_extension_for_target_event = 24,
Expand All @@ -93,7 +95,7 @@
#' # - At least 250 events have occurred.
#' # - At least 10 months after IA1.
#' # However, if events accumulation is slow, we will wait for a maximum of 34 months.
#' ia2 <- create_cutting(
#' ia2 <- create_cut(
#' planned_calendar_time = 32,
#' target_event_overall = 200,
#' max_extension_for_target_event = 34,
Expand All @@ -104,7 +106,7 @@
#' # The final analysis will occur at the later of the following 2 conditions:
#' # - At least 45 months have passed since the start of the study.
#' # - At least 300 events have occurred.
#' fa <- create_cutting(
#' fa <- create_cut(
#' planned_calendar_time = 45,
#' target_event_overall = 350
#' )
Expand All @@ -116,7 +118,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = wlr,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = fh(rho = 0, gamma = 0)
#' )
Expand All @@ -128,7 +130,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = wlr,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = fh(rho = 0, gamma = 0.5)
#' )
Expand All @@ -140,7 +142,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = wlr,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = mb(delay = 3)
#' )
Expand All @@ -152,7 +154,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = wlr,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' weight = early_zero(6)
#' )
Expand All @@ -164,7 +166,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = rmst,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' tau = 20
#' )
Expand All @@ -176,7 +178,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = milestone,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' ms_time = 10
#' )
Expand All @@ -189,7 +191,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = maxcombo,
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' rho = c(0, 0),
#' gamma = c(0, 0.5)
Expand All @@ -204,7 +206,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = maxcombo(test1 = wlr, test2 = milestone),
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' test1_par = list(weight = fh(rho = 0, gamma = 0.5)),
#' test2_par = list(ms_time = 10)
Expand All @@ -220,7 +222,7 @@
#' enroll_rate = enroll_rate,
#' fail_rate = fail_rate,
#' test = list(ia1 = wlr, ia2 = wlr, fa = maxcombo),
#' cutting = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' cut = list(ia1 = ia1, ia2 = ia2, fa = fa),
#' seed = 2024,
#' test_par = list(
#' ia1 = list(weight = fh(rho = 0, gamma = 0)),
Expand All @@ -247,7 +249,7 @@ sim_gs_n <- function(
),
block = rep(c("experimental", "control"), 2),
test = wlr,
cutting = NULL,
cut = NULL,
seed = 2024,
...) {
# Input checking
Expand All @@ -268,7 +270,7 @@ sim_gs_n <- function(
)

# Initialize the cut date of IA(s) and FA
n_analysis <- length(cutting)
n_analysis <- length(cut)
cut_date <- rep(-100, n_analysis)
ans_1sim <- NULL

Expand All @@ -278,14 +280,14 @@ sim_gs_n <- function(
test <- vector(mode = "list", length = n_analysis)
test[] <- list(test_single)
}
if (length(test) != length(cutting)) {
if (length(test) != length(cut)) {
stop("If you want to run different tests at each cutting, the list of
tests must be the same length as the list of cuttings")
}

for (i_analysis in seq_len(n_analysis)) {
# Get cut date
cut_date[i_analysis] <- cutting[[i_analysis]](simu_data)
cut_date[i_analysis] <- cut[[i_analysis]](simu_data)

# Cut the data
simu_data_cut <- simu_data |> cut_data_by_date(cut_date[i_analysis])
Expand Down Expand Up @@ -327,14 +329,14 @@ sim_gs_n <- function(
#' # Create a cutting function that applies the following 2 conditions:
#' # - At least 45 months have passed since the start of the study
#' # - At least 300 events have occurred
#' cutting <- create_cutting(
#' cutting <- create_cut(
#' planned_calendar_time = 45,
#' target_event_overall = 350
#' )
#'
#' # Cut the trial data
#' cutting(trial_data)
create_cutting <- function(...) {
create_cut <- function(...) {
function(data) {
get_analysis_date(data, ...)
}
Expand All @@ -352,7 +354,7 @@ create_cutting <- function(...) {
#'
#' @export
#'
#' @seealso [sim_gs_n()], [create_cutting()]
#' @seealso [sim_gs_n()], [create_cut()]
#'
#' @examples
#' # Simulate trial data
Expand All @@ -362,7 +364,7 @@ create_cutting <- function(...) {
#' trial_data_cut <- cut_data_by_event(trial_data, 150)
#'
#' # Create a cutting test function that can be used by sim_gs_n()
#' regular_logrank_test <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0))
#' regular_logrank_test <- create_test(wlr, weight = fh(rho = 0, gamma = 0))
#'
#' # Test the cutting
#' regular_logrank_test(trial_data_cut)
Expand All @@ -372,7 +374,7 @@ create_cutting <- function(...) {
#' regular_logrank_test(trial_data_cut),
#' wlr(trial_data_cut, weight = fh(rho = 0, gamma = 0))
#' ))
create_cutting_test <- function(test, ...) {
create_test <- function(test, ...) {
stopifnot(is.function(test))
function(data) {
test(data, ...)
Expand All @@ -386,24 +388,24 @@ create_cutting_test <- function(test, ...) {
#' features.
#'
#' @param data Trial data cut by [cut_data_by_event()] or [cut_data_by_date()]
#' @param ... One or more test functions. Use [create_cutting_test()] to change
#' @param ... One or more test functions. Use [create_test()] to change
#' the default arguments of each test function.
#'
#' @return A list of test results, one per test. If the test functions are named
#' in the call to `multitest()`, the returned list uses the same names.
#'
#' @export
#'
#' @seealso [create_cutting_test()]
#' @seealso [create_test()]
#'
#' @examples
#' trial_data <- sim_pw_surv(n = 200)
#' trial_data_cut <- cut_data_by_event(trial_data, 150)
#'
#' # create cutting test functions
#' wlr_partial <- create_cutting_test(wlr, weight = fh(rho = 0, gamma = 0))
#' rmst_partial <- create_cutting_test(rmst, tau = 20)
#' maxcombo_partial <- create_cutting_test(maxcombo, rho = c(0, 0), gamma = c(0, 0.5))
#' wlr_partial <- create_test(wlr, weight = fh(rho = 0, gamma = 0))
#' rmst_partial <- create_test(rmst, tau = 20)
#' maxcombo_partial <- create_test(maxcombo, rho = c(0, 0), gamma = c(0, 0.5))
#'
#' multitest(
#' data = trial_data_cut,
Expand Down
4 changes: 2 additions & 2 deletions _pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ reference:
- cut_data_by_event
- get_cut_date_by_event
- get_analysis_date
- create_cutting
- create_cut

- title: "Compute p-values/test statistics"
contents:
Expand All @@ -53,7 +53,7 @@ reference:
- milestone
- wlr
- maxcombo
- create_cutting_test
- create_test
- multitest

- title: "Randomization algorithms"
Expand Down
8 changes: 4 additions & 4 deletions man/create_cutting.Rd → man/create_cut.Rd

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

10 changes: 5 additions & 5 deletions man/create_cutting_test.Rd → man/create_test.Rd

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

10 changes: 5 additions & 5 deletions man/multitest.Rd

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

Loading