minor update

Author: Thomas Debray

R/SampleSize.R

@@ -144,7 +144,7 @@ sampleSize <- function(mu_list, varcov_list = NA, sigma_list = NA, cor_mat = NA,
 
   # Conduct validations
   validate_sample_size_limits(lower = lower, upper = upper)
-  validate_tar(TAR = TAR, n_arms = n)
+  TAR <- derive_TAR(TAR = TAR, n_arms = n)
 
 
   # Derive the Arm Names
@@ -736,3 +736,55 @@ derive_varcov_list <- function(mu_list, sigma_list, ynames_list, varcov_list = N
   return(varcov_list)
 }
 
+#' Derive Treatment Allocation Rate (TAR)
+#'
+#' This function validates and adjusts the treatment allocation rate (`TAR`) to ensure it matches
+#' the number of treatment arms (`n_arms`). If `TAR` is missing or NULL, it is set to a default
+#' vector of ones. If `TAR` is shorter than `n_arms`, missing values are replaced with ones.
+#' If `TAR` contains NA values, they are replaced with ones. If `TAR` exceeds `n_arms` in length
+#' or contains non-positive values, an error is raised.
+#'
+#' @param TAR Numeric vector. Treatment allocation rates for each arm.
+#' @param n_arms Numeric. The number of treatment arms that `TAR` must correspond to.
+#'
+#' @details
+#' - If `TAR` is NULL or missing, it is set to a vector of ones of length `n_arms`.
+#' - If `TAR` is shorter than `n_arms`, missing values are replaced with ones and a warning is issued.
+#' - If `TAR` is longer than `n_arms`, an error is raised.
+#' - If `TAR` contains NA values, they are replaced with ones and a warning is issued.
+#' - If `TAR` contains negative or zero values, an error is raised.
+#'
+#' @author
+#' Thomas Debray \email{[email protected]}
+#'
+#' @return A numeric vector of length `n_arms`, where any missing or NA values in `TAR`
+#' have been replaced with ones.
+derive_TAR <- function(TAR = NULL, n_arms) {
+
+  if (missing(TAR) || is.null(TAR)) {
+    warning("Warning: TAR is missing or NULL. Setting TAR to a default vector of ones.")
+    TAR <- rep(1, n_arms)
+  }
+
+  # Ensure TAR has the correct length by filling missing values with 1
+  if (length(TAR) < n_arms) {
+    warning("Warning: TAR length is shorter than the number of arms. Missing values will be replaced with 1.")
+    TAR <- c(TAR, rep(1, n_arms - length(TAR)))
+  } else if (length(TAR) > n_arms) {
+    stop("Validation Error: The length of TAR must not exceed the number of arms specified by n_arms.")
+  }
+
+  # Replace any NA values with 1
+  if (any(is.na(TAR))) {
+    warning("Warning: NA values detected in TAR. These will be replaced with 1.")
+    TAR[is.na(TAR)] <- 1
+  }
+
+  # Validate that all values are positive
+  if (any(TAR <= 0, na.rm = TRUE)) {
+    stop("Validation Error: TAR must contain only positive values. Negative or zero values are not allowed.")
+  }
+
+  return(TAR)
+}
+

R/utils.R

@@ -221,7 +221,8 @@ test_studies <- function(nsim, n, comp, param, param.d, arm_seed, ncores){
                                           SigmaT = as.matrix(SigmaT),SigmaR = as.matrix(SigmaR),
                                           lequi_tol = lequi.tol ,uequi_tol = uequi.tol,
                                           alpha = alpha, k = k, dropout = as.numeric(c(dropout[treat1],dropout[treat2])),
-                                          typey = which(param$type_y[endp] == 1) - 1, adseq=param.d$adjust=="seq",
+                                          typey = ifelse(any(param$type_y[endp] == 1),which(param$type_y[endp] == 1) - 1,-1),
+                                          adseq=param.d$adjust=="seq",
                                           arm_seedT = arm_seedx[treat1], arm_seedR = arm_seedx[treat2],
                                           TART = param$TAR_list[[treat1]], TARR = param$TAR_list[[treat2]],
                                           vareq =param.d$vareq))
@@ -231,7 +232,7 @@ test_studies <- function(nsim, n, comp, param, param.d, arm_seed, ncores){
                                           SigmaT = as.matrix(SigmaT),SigmaR = as.matrix(SigmaR),
                                           lequi_tol = lequi.tol ,uequi_tol = uequi.tol,
                                           alpha = alpha, k = k, dropout = as.numeric(c(dropout[treat1],dropout[treat2])),
-                                          typey = which(param$type_y[endp] == 1) - 1,
+                                          typey = ifelse(any(param$type_y[endp] == 1),which(param$type_y[endp] == 1) - 1,-1),
                                           adseq = param.d$adjust=="seq",
                                           arm_seedT = arm_seedx[treat1], arm_seedR = arm_seedx[treat2],
                                           TART = param$TAR_list[[treat1]], TARR = param$TAR_list[[treat2]],

R/validation.R

@@ -63,34 +63,5 @@ validate_positive_definite <- function(varcov_list) {
   }
 }
 
-#' Validate Treatment Allocation Rate (TAR)
-#'
-#' This function validates whether the length of the treatment allocation rate (`TAR`) matches
-#' the number of treatment arms (`arm_names`). If the lengths do not match, it throws an error.
-#'
-#' @param TAR Numeric vector. Treatment allocation rates for each arm.
-#' @param n_arms Numeric. The number of treatment arms that `TAR` must correspond to.
-#'
-#' @author
-#' Thomas Debray \email{[email protected]}
-#' @return NULL (used for validation only).
-validate_tar <- function(TAR = NULL, n_arms) {
-  if (missing(TAR)) {
-    return(NULL)
-  }
-  if (is.null(TAR)) {
-    return(NULL)
-  }
 
-  # Validate TAR length
-  if (length(TAR) != n_arms) {
-    stop("Validation Error: The length of TAR must match the number of arms specified by arm_names.")
-  }
-
-  if (any(TAR <= 0, na.rm = TRUE)) {
-    stop("Validation Error: TAR must contain only positive values. Negative or zero values are not allowed.")
-  }
-
-
-}