Deviating from assumptions [Power / Sample Size]

posted by Helmut Homepage – Vienna, Austria, 2014-08-08 17:44 (3542 d 21:31 ago) – Posting: # 13353
Views: 24,080

Dear all,

in this recent post I claimed that drop-outs have a lower impact on power of a study than the CV and – especially – the GMR. The order is sample size < CV GMR. I prepared some R-code (given at the end) which allows a quick comparison.
THX to Detlew for reminding me about R’s uniroot().

Two examples showing the influence of actual values deviating from assumptions (I have chosen a mini­mum power of 70% for the actual study):
  1. GMR 0.95, CV 20%, target power 90%, 2×2 cross-over design:
    We estimate a sample size of 26 subjects and could expect ~92% power if all assumptions would be realized in the study.

    [image]

    min. power  parameter  value    rel. change
       (%)                              (%)    
    ───────────────────────────────────────────
      70           CV      27.29      +36.4    
      70           GMR      0.9044    - 4.80   
      73.54        n       16         -38.5    


    The sample size is the least sensitive one (with 15 subjects we would get 69.93% power and a rel. change of -42.3%), followed by the CV. The GMR is the most nasty one.

  2. GMR 1.05, CV 34%, target power 80%, parallel design:
    We estimate a sample size of 94 subjects (47 per group) and could expect ~80% power if all assumptions would be realized in the study.

    [image]

    min. power  parameter  value    rel. change
       (%)                              (%)    
    ───────────────────────────────────────────
      70           CV      38.47      +13.1    
      70           GMR      1.076     + 2.48   
      70.12        n       75         -20.2    


    Again the sensitivity is GMR ≫ CV > sample size.
This little exercise is not a substitute for the sensitivity analysis which should be performed in study planning according to ICH E9 (see f.i. this presentation, slides 49–53) but support the fact that drop-outs influence the study’s power to the least extent if compared to the other parameters.
In real studies all potential influences occur simultaneously. In the first example both GMR=0.94, CV=23%, n=24 or GMR=0.93, CV=20%, n=23 will result in ~80% power.

I know some CROs whose PIs notoriously try to “convince” volunteers not to leave the study being afraid of loosing power.
Such a practice is not only unethical but completely unjustified!


R-code (developed in R 3.1.6 64-bit, PowerTOST 1.1-12):

CV         <- 0.20
GMR        <- 0.95
pwr.target <- 0.90  # wishful thinking...
pwr.min    <- 0.70  # we don't want to drop below that...
des        <- "2x2" # call known.designs() to see PowerTOST's
                    # only designs with two sequences and "parallel"
                    # are implemented yet for drop-outs
####################################################################
# Don't modify below this line unless you know what you are doing. #
####################################################################
designs <- c("2x2", "2x2x2", "2x2x3", "2x2x4", "parallel")
require(PowerTOST)
pwrCV  <- function(x, ...) { power.TOST(CV=x, n=n.est, theta0=GMR, design=des)-pwr.min }
pwrGMR <- function(x, ...) { power.TOST(theta0=x, n=n.est, CV=CV, design=des)-pwr.min }
res    <- sampleN.TOST(CV=CV, theta0=GMR, targetpower=pwr.target, design=des,
  print=F, details=F)
n.est   <- res[1, "Sample size"   ]
pwr.est <- res[1, "Achieved power"]
seg     <- 50; segs <- seq(seg-1)
########################################
# max. CV for minimum acceptable power #
########################################
CV.max  <- uniroot(pwrCV,  c(CV, 10*CV), tol=1e-7, n=n.est, theta0=GMR)$root
CVs <- seq(CV, CV.max, length.out=seg)
pBECV <- NULL
for(j in 1:length(CVs)) {
  pBECV <- c(pBECV, 100*power.TOST(CV=CVs[j], n=n.est, theta0=GMR, design=des))
}
######################################
# min. GMR for minimum accept. power #
######################################
ifelse(GMR <= 1, int <- c(0.8, 1), int <- c(GMR, 1.25))
GMR.min <- uniroot(pwrGMR, int, tol=1e-7, n=n.est, CV=CV, design=des)$root
GMRs <- seq(GMR.min, GMR, length.out=seg)
pBEGMR <- NULL
for(j in 1:length(GMRs)) {
  pBEGMR <- c(pBEGMR, 100*power.TOST(CV=CV, n=n.est, theta0=GMRs[j], design=des))
}
####################################
# min. n for minimum accept. power #
# workaround, since uniroot() does #
# not accept two vectors as limits #
####################################
if(des %in% designs) {
  Ns <- seq(n.est, 12, by=-1)
  j <- 0
  pwrN <- pwr.est
  n.min <- NULL; pBEn <- NULL
  while(pwrN >= pwr.min) {
    j <- j+1
    n1 <- Ns[j]-floor(Ns[j]/2)
    n2 <- Ns[j]-n1
    n <- c(n1, n2)
    pwrN <- power2.TOST(CV=CV, n=n, theta0=GMR, design=des)
    if(pwrN >= pwr.min) {
      n.min <- c(n.min, sum(n))
      pBEn <- c(pBEn, 100*pwrN)
    } else {
      break
    }
  }
}
op <- par()
par(mar=c(c(4, 4, 2.5, 0.5))+0.1) # default for B, L, T, R: c(5, 4, 4, 2) + 0.1
clr <- colorRampPalette(c("blue", "red"))(seg)
split.screen(c(2, 2))
screen(1)
plot(100*CVs, pBECV, type="n", main=paste0("Higher variability\n",
  "GMR = ", GMR, ", n = ", n.est), lwd=2, xlab="CV%", ylab="% power", las=1, cex.main=1)
abline(h=c(100*pwr.target, 80, 100*pwr.min), lty=3, col="grey50")
segments(100*CVs[segs], pBECV[segs], 100*CVs[segs+1], pBECV[segs+1], lwd=2, col=clr[segs])
points(100*CVs[1], pBECV[1], col=clr[1], pch=16, cex=1.25)
points(100*CVs[seg], pBECV[seg], col=clr[seg], pch=16, cex=1.25)
text(100*CV, 100*(pwr.min+(pwr.est-pwr.min)*0.1), labels=paste0("CV = ",
  signif(100*CV.max, 4), "% (", round(100*pwr.min, 2), "%)"), cex=0.9, pos=4)
screen(2)
clr <- rev(clr)
plot(GMRs, pBEGMR, type="n", main=paste0("Larger deviation from 1\n",
  "CV = ", 100*CV, "%, n = ", n.est), lwd=2, xlim=c(GMR, GMR.min),
  xlab="GMR", ylab="% power", las=1, cex.main=1)
abline(h=c(100*pwr.target, 80, 100*pwr.min), lty=3, col="grey50")
segments(GMRs[segs], pBEGMR[segs], GMRs[segs+1], pBEGMR[segs+1], lwd=2, col=clr[segs])
points(GMRs[1], pBEGMR[1], col=clr[1], pch=16, cex=1.25)
points(GMRs[seg], pBEGMR[seg], col=clr[seg], pch=16, cex=1.25)
text(GMR, 100*(pwr.min+(pwr.est-pwr.min)*0.1), labels=paste0("GMR = ",
  signif(GMR.min, 4), " (", round(100*pwr.min, 2), "%)"), cex=0.9, pos=4)
screen(3)
if(des %in% designs) {
  plot(n.min, pBEn, type="n", main=paste0("Drop-outs\n",
    "GMR = ", GMR, ", CV = ", 100*CV, "%"), lwd=2, xlim=c(max(n.min), min(n.min)),
    ylim=c(100*pwr.min, 100*pwr.est), xlab="n", ylab="% power", las=1, cex.main=1)
  abline(h=c(100*pwr.target, 80, 100*pwr.min), lty=3, col="grey50")
  clr <- colorRampPalette(c("blue", "red"))(length(n.min))
  points(n.min, pBEn, pch=16, cex=0.8, col=clr)
  points(n.min[1], pBEn[1], col=clr[1], pch=16, cex=1.25)
  points(n.min[length(n.min)], pBEn[length(n.min)], col=clr[length(n.min)],
    pch=16, cex=1.25)
  text(max(n.min), 100*(pwr.min+(pwr.est-pwr.min)*0.1), labels=paste0("n = ",
    min(n.min), " (", signif(min(pBEn), 4), "%)"), cex=0.9, pos=4)
} else {
  plot(1, type="n", axes=F, xlab="", ylab="")
  legend("topleft", legend=c(paste0("Note:\nAnalysis of drop-outs",
    "\nnot implemented for\n", des, " design.")), bty="n", cex=1)
}
screen(4)
plot(1, type="n", axes=F, xlab="", ylab="")
legend("topleft", legend=c(paste0("design: ", des), "assumed values:",
  paste0("  CV = ",  round(100*CV, 2), "%, GMR = ", round(GMR, 4)), "power:",
  paste0("  target = ",  round(100*pwr.target, 2), "%"),
  paste0("  expected = ",  signif(100*pwr.est, 4), "% (n = ", n.est, ")"),
  paste0("  minimum acceptable = ", round(100*pwr.min, 2), "%")), bty="n", cex=1)
close.screen(all=T)
par <- op
cat(paste0("\ndesign: ", des, "\nCV=", 100*CV, "%, GMR=", 100*GMR, "%, n=",
  n.est, ", expected power=", signif(100*pwr.est, 4), "% (>target of ",
  100*pwr.target, "%)\n\n"))

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
22,988 posts in 4,825 threads, 1,654 registered users;
103 visitors (0 registered, 103 guests [including 9 identified bots]).
Forum time: 15:15 CEST (Europe/Vienna)

The whole purpose of education is
to turn mirrors into windows.    Sydney J. Harris

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