R-code for balance [Two-Stage / GS Designs]

posted by Helmut Homepage – Vienna, Austria, 2014-01-04 23:36 (4055 d 02:45 ago) – Posting: # 12139
Views: 7,303

Hi Tina,

in case you have [image], a gimmick which keeps the overall balance in most cases. Quick, dirty, and almost untested. :pirate:

TSD <- function(method1, method2, n1, n1.1, n1.2, CV, do.2) {
  ############################################################
  # Modify the function only if you know what you are doing! #
  ############################################################
  require(PowerTOST)            # what else?
  n1.e   <- n1.1+n1.2           # stage 1: eligible subjects
  n1.ar  <- n1.2/n1.1           # stage 1: sequence allocation ratio
  do.r   <- abs((n1.e-n1)/n1)   # stage 1: drop-out rate
  if(!missing(do.2)) do.2 <- do.2/100 # expect. drop-out rate stage 2
  if(missing(do.2)) do.2  <- do.r     # apply 1st if not given
  CV     <- CV/100
  if (method1 == 1) {adj <- 0.0294; GMR <- 0.95; pwr <- 0.8}
  if (method1 == 2) {adj <- 0.0280; GMR <- 0.90; pwr <- 0.8}
  if (method1 == 3) {adj <- 0.0284; GMR <- 0.95; pwr <- 0.9}
  if (method1 == 4) {adj <- 0.0274; GMR <- 0.95; pwr <- 0.9}
  if (method1 == 5) {adj <- 0.0269; GMR <- 0.90; pwr <- 0.9}
  if (method2 == 1) me <- "exact"
  if (method2 == 2) me <- "nct"
  if (method2 == 3) me <- "shifted"
  nt     <- as.numeric(sampleN.TOST(alpha=adj, CV=CV, theta0=GMR,
              targetpower=pwr, method=me, print=FALSE)[7])
  n2.p   <- nt-n1.e                # preliminary stage 2 sample size
  n2.1   <- ceiling((nt/2-n1.1)/(1-do.2)) # adjust for drop-outs
  n2.2   <- ceiling((nt/2-n1.2)/(1-do.2)) # adjust for drop-outs
  n2     <- n2.1+n2.2              # dosed in stage 2
  n2.1e  <- round(n2.1*(1-do.2), 0)# stage 2: expected eligible subjects in seq. 1
  n2.2e  <- round(n2.2*(1-do.2), 0)# stage 2: expected eligible subjects in seq. 2
  n2.e   <- n2.1e+n2.2e            # stage 2: expected eligible subjects
  n2.ar  <- n2.2e/n2.1e            # stage 2: sequence allocation ratio
  ar     <- (n1.2+n2.2e)/(n1.1+n2.1e) # pooled data’s allocation ratio
  ifelse(ar == 1, bal <- "(balanced)", bal <- "(imbalanced)")
  sep    <- paste(paste0(rep("\u2500", 49), collapse=""), "\n")
  if(method2 > 1) me <- c(me, "t-distribution")
  cat("\n TSD-method:", method1,
  paste0("(\u03b1=", adj, ", GMR=", 100*GMR, "%, power=", 100*pwr, "%)\n"),
  "Sample size estimation:", me, "\n", sep,
  "Stage 1\n", sep,
  "randomized/dosed subjects …………………………………", n1, "\n",
  "eligible subjects (drop-outs)…………………………", n1.e, paste0("(", n1-n1.e,")"), "\n",
  "eligible subjects in sequences RT|TR ……", paste0(n1.1, "|", n1.2), "\n",
  "allocation ratio RT/TR …………………………………………", paste0("1:", signif(n1.ar, 4)), "\n",
  "drop-out rate  ………………………………………………………………", paste0(signif(100*do.r, 4), "%\n"), sep,
  "Interim analysis\n", sep,
  "relevant PK metrics’ maximum CV …………………", paste0(signif(100*CV, 4), "%\n"),
  "estimated total sample size ……………………………", as.numeric(nt), "\n", sep,
  "Stage 2\n", sep,
  "preliminary sample size ………………………………………", n2.p, "\n",
  "expected drop-out rate …………………………………………", paste0(signif(100*do.2, 4),"%\n"),
  "final sample size (adj. for drop-outs) ", n2, "\n",
  "randomized subjects in sequences RT|TR ", paste0(n2.1, "|", n2.2), "\n",
  "expected eligible subj. in seq. RT|TR …", paste0(n2.1e, "|", n2.2e), "\n",
  "allocation ratio RT/TR …………………………………………", paste0("1:", signif(n2.ar, 4)), "\n", sep,
  "Pooled data set\n", sep,
  "expected eligible subjects ………………………………", n1.e+n2.e, "\n",
  "expected eligible subj. in seq. RT|TR …", paste0(n1.1+n2.1e, "|", n1.2+n2.2e), "\n",
  "allocation ratio RT/TR …………………………………………", paste0("1:", signif(ar, 4)), bal, "\n\n")
}
################
# Stage 1 data #
################
method1 <- 1 # select from TSD-Methods 1–5
###################################################
#                                     GMR% power% #
# 1 Potvin et al. (2008) Methods B/C:  95    80   #
# 2 Montague et al. (2011) Method D:   90    80   #
# 3 Fuglsang (2013) Method B:          95    90   #
# 4 Fuglsang (2013) Method C1/D1:      95    90   #
# 5 Fuglsang (2013) Method C2/D2:      90    90   #
###################################################
method2 <- 1 # select from power-estimation Methods 1–3
#######################################
# 1 exact (Owen’s Q-function): best   #
# 2 noncentral t-distribution: better #
# 3 shifted t-distribution:    good   #
#######################################
n1   <- 24 # dosed subjects
n1.1 <- 11 # eligible subjects in sequence RT
n1.2 <- 7  # eligible subjects in sequence TR
CV   <- 23 # maximum CV in percent
TSD(method1, method2, n1, n1.1, n1.2, CV) # call the function


A little bit more extreme than my previous example:

TSD-method: 1 (α=0.0294, GMR=95%, power=80%)
Sample size estimation: exact
─────────────────────────────────────────────────
Stage 1
─────────────────────────────────────────────────
randomized/dosed subjects ………………………………… 24
eligible subjects (drop-outs)………………………… 18 (6)
eligible subjects in sequences RT|TR …… 11|7
allocation ratio RT/TR ………………………………………… 1:0.6364
drop-out rate  ……………………………………………………………… 25%
─────────────────────────────────────────────────
Interim analysis
─────────────────────────────────────────────────
relevant PK metrics’ maximum CV ………………… 23%
estimated total sample size …………………………… 30
─────────────────────────────────────────────────
Stage 2
─────────────────────────────────────────────────
preliminary sample size ……………………………………… 12
expected drop-out rate ………………………………………… 25%
final sample size (adj. for drop-outs)  17
randomized subjects in sequences RT|TR  6|11
expected eligible subj. in seq. RT|TR … 4|8
allocation ratio RT/TR ………………………………………… 1:2
─────────────────────────────────────────────────
Pooled data set
─────────────────────────────────────────────────
expected eligible subjects ……………………………… 30
expected eligible subj. in seq. RT|TR … 15|15
allocation ratio RT/TR ………………………………………… 1:1 (balanced)


Be sure to use the same sample size estimation method which you applied in the power estimation of the decision scheme. Available are "exact" (based on Owen’s Q function, preferred), "nct" (based on the noncentral t-distribution), and "shifted" (based on the shifted central t-distribution).
Sometimes crazy things happen. If your area was hit be a flu epidemic during the first stage, it might be reasonable to assume a lower drop-out rate for the second stage. Use the optional variable do.2 (expected drop-out rate in percent). Example: Method D, noncentral t, and a 10% drop-out rate:

TSD-method: 2 (α=0.028, GMR=90%, power=80%)
Sample size estimation: noncentral t-distribution
─────────────────────────────────────────────────
Stage 1
─────────────────────────────────────────────────
randomized/dosed subjects ………………………………… 24
eligible subjects (drop-outs)………………………… 18 (6)
eligible subjects in sequences RT|TR …… 11|7
allocation ratio RT/TR ………………………………………… 1:0.6364
drop-out rate  ……………………………………………………………… 25%
─────────────────────────────────────────────────
Interim analysis
─────────────────────────────────────────────────
relevant PK metrics’ maximum CV ………………… 23%
estimated total sample size …………………………… 60
─────────────────────────────────────────────────
Stage 2
─────────────────────────────────────────────────
preliminary sample size ……………………………………… 42
expected drop-out rate ………………………………………… 10%
final sample size (adj. for drop-outs)  48
randomized subjects in sequences RT|TR  22|26
expected eligible subj. in seq. RT|TR … 20|23
allocation ratio RT/TR ………………………………………… 1:1.15
─────────────────────────────────────────────────
Pooled data set
─────────────────────────────────────────────────
expected eligible subjects ……………………………… 61
expected eligible subj. in seq. RT|TR … 31|30
allocation ratio RT/TR ………………………………………… 1:0.9677 (imbalanced)

Dif-tor heh smusma 🖖🏼 Довге життя Україна! [image]
Helmut Schütz
[image]

The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes

Complete thread:

UA Flag
Activity
 Admin contact
23,379 posts in 4,913 threads, 1,661 registered users;
255 visitors (0 registered, 255 guests [including 14 identified bots]).
Forum time: 02:22 CET (Europe/Vienna)

Statistics is the art of never having to say you’re wrong.
Variance is what any two statisticians are at.    C.J. Bradfield

The Bioequivalence and Bioavailability Forum is hosted by
BEBAC Ing. Helmut Schütz
HTML5