rpact-com / rpact

rpact: Confirmatory Adaptive Clinical Trial Design and Analysis
https://rpact-com.github.io/rpact/
23 stars 5 forks source link

[Feature request] Sample size for fixed duration survival studies #58

Closed bjoernholzhauer closed 3 weeks ago

bjoernholzhauer commented 1 month ago

I'd like to calculate the sample size (or power given sample size) for a fixed duration survival study. These are pretty common in some areas such as atrial fibrillation (e.g. these two studies or this one).

Maybe I missed how to do this, but I have not found anything better than the below, where I do a search loop over sample sizes until the trial duration is as desired:

library(rpact)

getSampleSizeSurvival_fixed_duration <- function(target_duration=1, initial_n=1000, 
                                                 min_n=1, max_n=10000000, tol=1e-3, ...) {
  # Function to get follow-up time given n_to_test
  get_followup_time <- function(n_to_test, ...) {
    tmp_ <- getSampleSizeSurvival(accrualTime = c(0, 1e-9), 
                                  accrualIntensity = n_to_test/1e-9,
                                  maxNumberOfSubjects = n_to_test, 
                                  ...)
    return(tmp_$followUpTime)
  }

  # Initial values
  n_to_test <- initial_n
  low_n <- min_n
  high_n <- max_n

  # Binary search loop
  while (high_n - low_n > tol & ceiling(high_n) != ceiling(low_n)) {

    followup_time <- get_followup_time(n_to_test, ...)
    #print(paste0("n=", n_to_test, ", low_n=", low_n, ", high_n=", high_n, ", fupt=", followup_time))

    if (abs(followup_time - target_duration) <= tol | ceiling(high_n) == ceiling(low_n)) {
      # If follow-up time is close enough to target duration
      return(ceiling(n_to_test))
    } else if (followup_time > target_duration) {
      # If the trial is too short, increase sample size
      low_n <- n_to_test
    } else {
      # If the trial is too long, decrease sample size
      high_n <- n_to_test
    }

    # Update sample size by taking the midpoint of the current range
    if ((low_n + high_n) / 2 > n_to_test*2){
      n_to_test <- 2 * n_to_test
    } else if ((low_n + high_n) / 2 < n_to_test/2){
      n_to_test <- n_to_test/2
    } else {
      n_to_test <- (low_n + high_n) / 2 
    }
  }

  # Return the sample size found
  return(ceiling(n_to_test))
}

getSampleSizeSurvival_fixed_duration(target_duration=1,
                                     alpha=0.05, beta=0.1, sided=2, 
                                     dropoutRate1 = 0.025, dropoutRate2 = 0.025, 
                                     lambda2 = 0.5, hazardRatio = 0.7)
gwassmer commented 3 weeks ago

Idea is correct, but the loop search is not necessary:

getSampleSizeSurvival(alpha=0.05, beta=0.1, sided=2, accrualTime = c(0, 1e-9), followUpTime = 1, dropoutRate1 = 0.025, dropoutRate2 = 0.025, lambda2 = 0.5, hazardRatio = 0.7 ) |> fetch(maxNumberOfSubjects) |> ceiling()