d_labes
★★★

Berlin, Germany,
2018-07-06 14:07
(2091 d 20:07 ago)

Posting: # 19025
Views: 2,534
 

 Power of Multiplicity Adjusted TOST [Power / Sample Size]

Dear All,

in this thread we have discussed if an adjustment of alpha has to be done if more then two formulations are to be compared.

Result: If the hypotheses to be tested are combined via 'or' there has to be an alpha adjustment applied to avoid an inflation of the overall alpha.

Bonferroni is one possibility, but may be too conservative. During thinking about that came a paper into my mind

Cheng Zheng, JixianWang and Lihui Zhaoa
Testing bioequivalence for multiple formulations with power and sample size calculations
Pharm Stat 2012 Jul-Aug;11(4):334-41. doi:10.1002/pst.1522. Epub 2012 Jun 12.

The authors of that paper have developed an R package MATOST wich deals with the implementation of combining multiple comparison adjustment approaches, such as Hochberg's or Dunnett's method, with TOST.
Meanwhile that package is no longer available, but only some spare R code can be found at https://sites.google.com/site/matostbe/, restricted to the Holm method for p-value adjustment.

I have taken that code and modified it to the aim of incorporating other methods, streamlining the input arguments and tried also to optimize the run-time. Here is the result of my attempt:

library(mvtnorm) # for multivariate normal
# function implementing section 2.3.1 of the MATOST paper
power_MATOST_S = function(alpha=0.05, n, r, CV, adjust=p.adjust.methods, nsims=50000)
{
# Calculation power based on pvalue adjustment and simulation for multiple contrasts
# The larger p value is selected before applying the adjustment
# n: total sample size (NOT per sequence as in nQuery)
#    only for balanced 2x2 design (!)
# r: expected ratios
# CV: intra-subject coefficient of variation (all-at-once ANOVA)

 
# Sigma: based on (log(CV^2+1)) with proper correlations around 0.5
  p   <- length(r)
  Cor <- diag(rep(1,p))
  for (i in 1:p) for (j in 1:p)
    if (i!=j) Cor[i,j]=0.5
   
  # attention! first sigma lower case, second upper case S
  sigma = rep(sqrt(log(CV^2+1)), p)
  Sigma = diag(sigma) %*% Cor %*% diag(sigma)

  set.seed(123456)   
  # reserve memory
  flag <- matrix(0, nsims, p)
  df_t <- (p+1)*n-(p+1)-(n-1)-p
  cfact  <- sqrt(2/n) # balanced designs
  cfact2 <- 2/n
  # acceptance range log-transformed
  lL <- log(0.8)
  lU <- log(1.25)

  # simulate contrasts
  r_me_n <- mvtnorm::rmvnorm(n=nsims, mean=log(r), sigma=Sigma * cfact2)
  # simulate mse (all-at-once). only for equal variabilities ?!
  s <- sqrt(rchisq(n=nsims, df=df_t) / df_t * Sigma[1,1])
 
  for (i in 1:nsims)
  {
    #calculate the two TOST p values for each contrast
    p1 <- 1 - sapply((r_me_n[i,] - lL) / (s[i] * cfact), function(x) pt(x, df=df_t))
    p2 <-     sapply((r_me_n[i,] - lU) / (s[i] * cfact), function(x) pt(x, df=df_t))
    # choose maximum as result
    p3 <- pmax(p1, p2)
    # adjust the p values for multiplicity
    p3 <- p.adjust(p3, adjust)
    flag[i, ] <- as.numeric(p3 <= alpha)
  }
  # what they next do in their code is beyond my understanding! what's alpha?
  # return(list(power=apply(flag, 2, sum)/nsims, alpha=sum(apply(flag, 1, sum)>0)/nsims))
  # seems they count column-wise (2) the BE decision and call that power
  # alpha: sum row-wise (1) and decide if >0 (i.e. 'or'), then sum that
  # this would be overall power/alpha for me

  pwr  <- sum(rowSums(flag)>0)/nsims
  pwrs <- colSums(flag)/nsims
  names(pwrs) <- paste("T", 1:p, "-R", sep="")
  return(list(power=pwr, pwrs=pwrs))
} # end function


Take that code with a grain of salt.
  • It is a quickshot without a full understanding what's happen behind the scenes.
  • It comes without any checks of the input arguments.
  • It is not the fastest code, therefore the default no of simulations is set to 50 000. Too low for an exploration if the TIE.
  • Find more limitations in the comments of the code.

Example call for comparing two test formulations with a reference, without multiplicity adjustment, assuming both test formulations are not bioequivalent to the reference:
power_MATOST_S(n=24, r=c(1.25, 1.25), CV=0.25, adjust="none")
This gives:
$`power`
[1] 0.08734

$pwrs
   T1-R    T2-R
0.04904 0.05092

(power is the overall probability of deciding BE for the hypothesis BE of T1-R or T2-R,
pwrs the probability of deciding BE for T1 and T2 alone)

As you see, there is an alpha inflation of the overall hypothesis.

Applying a multiplicity adjustment according to the Holm procedure gives:
power_MATOST_S(n=24, r=c(1.25, 1.25), CV=0.25, adjust="holm")
$`power`
[1] 0.0453

$pwrs
   T1-R    T2-R
0.02768 0.02810


Overall alpha is controlled.

The Bonferroni adjustment gives similar results:
power_MATOST_S(n=24, r=c(1.25, 1.25), CV=0.25, adjust="bonfer")
$`power`
[1] 0.0453

$pwrs
   T1-R    T2-R
0.02506 0.02562


Happy playing around with this tool :cool:.

BTW: Don't ask me about the details of the multiplicity adjustment methods. Take a good textbook about that.

Regards,

Detlew
UA Flag
Activity
 Admin contact
22,957 posts in 4,819 threads, 1,641 registered users;
42 visitors (0 registered, 42 guests [including 6 identified bots]).
Forum time: 09:15 CET (Europe/Vienna)

Nothing shows a lack of mathematical education more
than an overly precise calculation.    Carl Friedrich Gauß

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