Deviating from assumptions [Power / Sample Size]

posted by Helmut Homepage – Vienna, Austria, 2014-08-08 17:44 (3931 d 06:11 ago) – Posting: # 13353
Views: 25,608

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
23,424 posts in 4,927 threads, 1,670 registered users;
47 visitors (0 registered, 47 guests [including 5 identified bots]).
Forum time: 23:55 CEST (Europe/Vienna)

No matter what side of the argument you are on,
you always find people on your side
that you wish were on the other.    Thomas Berger

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