Skip to content

Commit

Permalink
Merge pull request #126 from Merck/125-remove-the-enroll_rate-=-from-…
Browse files Browse the repository at this point in the history 
…get_analysis_date

Remove `enroll_rate` from `get_analysis_date()`
  • Loading branch information
@LittleBeannie
LittleBeannie authored Nov 7, 2023
2 parents 03d43c4 + 98f3374 commit 607e03d
Show file tree
Hide file tree
Showing 3 changed files with 115 additions and 67 deletions.
104 changes: 45 additions & 59 deletions R/get_analysis_date.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@
#' previous analysis date.
#' @param min_time_after_previous_analysis A numerical value specifying the
#' planned minimum time after the previous analysis.
#' @param enroll_rate Enrollment rates, see details and examples.
#' @param min_n_overall A numerical value specifying the
#' minimal overall sample size enrolled to kick off the analysis.
#' @param min_n_per_stratum A numerical value specifying the
Expand Down Expand Up @@ -115,13 +114,16 @@
#' target_event_overall = 300
#' )
#'
#' # Example 4: Cut for analysis when there are at least 100 events
#' # Example 4a: Cut for analysis when there are at least 100 events
#' # in the biomarker-positive population, and at least 200 events
#' # in the biomarker-negative population, whichever arrives later.
#' get_analysis_date(
#' simulated_data,
#' target_event_per_stratum = c(100, 200)
#' )
#' # Example 4b: Cut for analysis when there are at least 100 events
#' # in the biomarker-positive population, but we don't have a requirement
#' # for the biomarker-negative population.
#' get_analysis_date(
#' simulated_data,
#' target_event_overall = 150,
Expand All @@ -142,22 +144,32 @@
#' # of the patients are enrolled in the overall population.
#' get_analysis_date(
#' simulated_data,
#' enroll_rate = enroll_rate,
#' min_n_overall = n * 0.8,
#' min_followup = 12
#' )
#'
#' # Example 7: Cut for analysis when 12 months after at least 200/160 patients
#' # Example 7a: Cut for analysis when 12 months after at least 200/160 patients
#' # are enrolled in the biomarker positive/negative population.
#' get_analysis_date(
#' simulated_data,
#' enroll_rate = enroll_rate,
#' min_n_per_stratum = c(200, 160),
#' min_followup = 12
#' )
#' # Example 7b: Cut for analysis when 12 months after at least 200 patients
#' # are enrolled in the biomarker positive population, but we don't have a
#' # specific requirement for the biomarker negative population.
#' get_analysis_date(
#' simulated_data,
#' enroll_rate = enroll_rate,
#' min_n_per_stratum = c(200, NA),
#' min_followup = 12
#' )
#' # Example 7c: Cut for analysis when 12 months after at least 200 patients
#' # are enrolled in the biomarker-positive population, but we don't have a
#' # specific requirement for the biomarker-negative population. We also want
#' # there are at least 80% of the patients enrolled in the overall population.
#' get_analysis_date(
#' simulated_data,
#' min_n_overall = n * 0.8,
#' min_n_per_stratum = c(200, NA),
#' min_followup = 12
#' )
Expand All @@ -174,7 +186,6 @@ get_analysis_date <- function(
previous_analysis_date = 0,
min_time_after_previous_analysis = NA,
# Option 5: Minimal follow-up time after specified enrollment fraction
enroll_rate = NA,
min_n_overall = NA,
min_n_per_stratum = NA,
min_followup = NA) {
Expand All @@ -187,31 +198,25 @@ get_analysis_date <- function(
input_check_vector(target_event_per_stratum, label = "target_event_per_stratum")
input_check_vector(min_n_per_stratum, label = "min_n_per_stratum")

# Check if enrollment is input by user
cond1 <- inherits(enroll_rate, c("tbl_df", "data.frame"))
# Check if `min_n_overall` is input by user
cond2 <- !is.na(min_n_overall)
cond1 <- !is.na(min_n_overall)
# Check if `min_n_per_stratum` is input by user
cond3 <- !all(is.na(min_n_overall))

if (cond1) {
n_max <- sum(enroll_rate$rate * enroll_rate$duration)
cond2 <- !all(is.na(min_n_overall))

n_max <- nrow(data)
# if user input either `min_n_overall` or `min_n_per_stratum`, it is required to input `min_followup`.
if(cond1 | cond2){
if (is.na(min_followup)) {
stop("`min_followup` must be provided.")
}

if (cond2) {
if (min_n_overall > n_max) {
stop("`min_n_overall` must be a positive number smaller than the total sample size.")
}
}

if (cond3) {
if (sum(min_n_per_stratum, na.rm = TRUE) > n_max) {
stop("`min_n_per_stratum` must be a sum of positive numbers smaller than the total sample size.")
}
}
}
# if user input `min_n_overall` but it > n_max, then output error message
if (cond1 & min_n_overall > n_max) {
stop("`min_n_overall` must be a positive number smaller than the total sample size.")
}
# if user input `min_n_per_stratum` but sum of it > n_max, then output error message
if (cond2 & sum(min_n_per_stratum, na.rm = TRUE) > n_max) {
stop("`min_n_per_stratum` must be a sum of positive numbers smaller than the total sample size.")
}

# Cutting option 1: Planned calendar time for the analysis
Expand Down Expand Up @@ -251,7 +256,10 @@ get_analysis_date <- function(
# Cutting option 5: Minimal follow-up time after specified enrollment fraction
# 5a: At least 10 months after the 80% of the patients are enrolled
if (!all(is.na(min_n_overall))) {
cut_date5a <- get_min_date(enroll_rate, min_n = min_n_overall) + min_followup
cut_date5a <- (data %>%
dplyr::arrange(enroll_time) %>%
dplyr::filter(dplyr::row_number() <= min_n_overall) %>%
dplyr::summarise(max_enroll_time = max(enroll_time)))$max_enroll_time + min_followup
} else {
cut_date5a <- NA
}
Expand All @@ -261,7 +269,16 @@ get_analysis_date <- function(
cut_date5b <- lapply(
seq_along(min_n_per_stratum),
function(x) {
get_min_date(enroll_rate %>% dplyr::filter(stratum == stratum[x]), min_n = min_n_per_stratum[x])
if(is.na(min_n_per_stratum[x])){
NA
} else {
(data %>%
dplyr::filter(stratum == stratum[x]) %>%
dplyr::arrange(enroll_time) %>%
dplyr::filter(dplyr::row_number() <= min_n_per_stratum[x]) %>%
dplyr::summarise(max_enroll_time = max(enroll_time))
)$max_enroll_time
}
}
) %>%
unlist() %>%
Expand All @@ -277,34 +294,3 @@ get_analysis_date <- function(
cut_date
}

input_check_scale <- function(x = NA, label = "x") {
if (!is.na(x)) {
if (is.numeric(x) && x < 0) {
stop(paste0(label, " must be a positive number."))
} else if (!is.numeric(x)) {
stop(paste0(label, " must be a numerical value."))
}
}
}

input_check_vector <- function(x = NA, label = "x") {
if (!(all(is.na(x) | (is.numeric(x) & x > 0)))) {
stop(paste0(label, " must be a positive number with either `NA` or positive numbers."))
}
}

get_min_date <- function(enroll_rate, min_n = 400) {
if (!is.na(min_n)) {
res <- stats::uniroot(
f = function(x) {
gsDesign2::expected_accrual(time = x, enroll_rate = enroll_rate) - min_n
},
interval = c(0, sum(enroll_rate$duration) + 1)
)
ans <- res$root
} else {
ans <- NA
}

ans
}
52 changes: 52 additions & 0 deletions R/input_checking.R
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,52 @@
# Copyright (c) 2023 Merck & Co., Inc., Rahway, NJ, USA and its affiliates.
# All rights reserved.
#
# This file is part of the simtrial program.
#
# simtrial is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.

#' Check if the input `x` is a numerical scale with values > 0
#'
#' @param x a scale
#' @param label the label of `x`
#'
#' @return an error message or nothing
#' @noRd
#' @examples
#' input_check_scale(x = 100, label = "my_x")
input_check_scale <- function(x = NA, label = "x") {
if (!is.na(x)) {
if (is.numeric(x) && x < 0) {
stop(paste0(label, " must be a positive number."))
} else if (!is.numeric(x)) {
stop(paste0(label, " must be a numerical value."))
}
}
}

#' Check if the input `x` is a numerical vector with values > 0 or NA
#'
#' @param x a vector
#' @param label the label of `x`
#'
#' @return an error message or nothing
#' @noRd
#' @examples
#' input_check_vector(x = 1:3, label = "my_x")
#' input_check_vector(x = c(1, 2, NA), label = "my_x")
input_check_vector <- function(x = NA, label = "x") {
if (!(all(is.na(x) | (is.numeric(x) & x > 0)))) {
stop(paste0(label, " must be a positive number with either `NA` or positive numbers."))
}
}
26 changes: 18 additions & 8 deletions man/get_analysis_date.Rd
View file

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

0 comments on commit 607e03d

Please sign in to comment.