Deficiencies 🇵🇱 [Study As­sess­ment]

posted by Helmut Homepage – Vienna, Austria, 2021-01-26 18:52 (40 d 02:33 ago) – Posting: # 22192
Views: 459

Hi ElMaestro,

» I understand your frustration.

I’m not frustrated. Just extremely surprised. :surprised:

» Here's a good basis for answering, just remember:
»
» 1. They do not know all the stuff that you know.

Given.

» 2. You cannot educate them.

Sooo sad!

» The rest is easy. :-)

Define ‘the rest’.
Crude [image]-script at the end. The example’s output:

Assumed CV    : 25.00%
Assumed PE    : 95.00%
Target power  : 90.00%
Sample size   : 38
Achieved power: 90.89%
Dosed         : 44 (anticipated dropout-rate of 10%)
  100,000 simulated 2×2×2 studies
            CV: 13.87 –  40.66% (geom. mean 24.62%)
            PE: 83.65 – 107.59% (geom. mean 94.99%)
            n : 28 – 37 (median 34)

passed BE (90% CI within 80.00 – 125.00%): 98.61%
percentages of passing studies
  with ‘post hoc’ power of <50%:  0.03%
                     ≥50 – <60%:  3.11%
                     ≥60 – <70%:  7.99%
                     ≥70 – <80%: 16.74%
                     ≥80 – <90%: 30.51%
                           >90%: 41.63%
  100% not within CI           :  5.76% (∆ stat. significant)

Although the target power was 90%, 58.38% of passing studies did so with ‘post hoc’ power of <90% (and 27.87% with less than 80%). So what?

To quote the WHO:

library(PowerTOST)
balance <- function(n, sequences) {
  # round up to get balanced sequences for potentially unbalanced case
  return (as.integer(sequences * (n %/% sequences + as.logical(n %% sequences))))
}
adjust.dropouts <- function(n, do.rate) {
  # to be dosed subjects which should result in n eligible subjects based on the
  # anticipated droput-rate

  return (as.integer(balance(n / (1 - do.rate), sequences = 2)))
}
set.seed(123456)
nsims   <- 1e5L # number of simulations
target  <- 0.90 # target power
CV      <- 25   # assumed CV
PE      <- 95   # assumed PE
do.rate <- 0.1  # anticipated dropout-rate
CV.do   <- 0.25 # assumed CV of the dropout-rate
tmp     <- sampleN.TOST(CV = CV/100, theta0 = PE/100, targetpower = target,
                        details = FALSE, print = FALSE)
n.des   <- tmp[["Sample size"]]
if (n.des >= 12) {
  power <- tmp[["Achieved power"]]
} else { # acc. to GL
  n.des <- 12
  power <- power.TOST(CV = CV/100, theta0 = PE/100, n = n.des)
}
n.adj   <- adjust.dropouts(n = n.des, do.rate = do.rate)
res     <- data.frame(CV = rep(NA, nsims), n = NA, PE = NA, lower = NA,
                      upper = NA, BE = FALSE, power = NA, signif = FALSE)
post    <- data.frame(sim = 1:nsims, pwr.50minus = FALSE, pwr.60 = FALSE,
                      pwr.70 = FALSE, pwr.80 = FALSE, pwr.90 = FALSE,
                      pwr.90plus = FALSE)
pb      <- txtProgressBar(0, 1, 0, char = "\u2588", width = NA, style = 3)
for (j in 1:nsims) {
  do           <- rlnorm(1, meanlog = log(do.rate) - 0.5*CV2mse(CV.do),
                            sdlog = sqrt(CV2mse(CV.do)))
  res$n[j]     <- as.integer(round(n.des * (1 - do)))
  res$CV[j]    <- 100*mse2CV(CV2mse(CV/100) *
                      rchisq(1, df = res$n[j] - 2)/(res$n[j] - 2))
  res$PE[j]    <- 100*exp(rnorm(1, mean = log(PE/100),
                          sd = sqrt(0.5 / res$n[j]) * sqrt(CV2mse(CV/100))))
  res[j, 4:5]  <- round(100*CI.BE(CV = res$CV[j]/100, pe = res$PE[j]/100,
                                  n = res$n[j]), 2)
  res$power[j] <- suppressMessages(
                    signif(power.TOST(CV = res$CV[j]/100, theta0 = res$PE[j]/100,
                                      n = res$n[j]), 5))
  if (res$lower[j] >= 80 & res$upper[j] <= 125) { # only the ones which pass
    res$BE[j] <- TRUE
    if (res$power[j] < 0.5) post$pwr.50minus[j] <- TRUE
    if (res$power[j] >= 0.5 & res$power[j] < 0.6) post$pwr.60[j] <- TRUE
    if (res$power[j] >= 0.6 & res$power[j] < 0.7) post$pwr.70[j] <- TRUE
    if (res$power[j] >= 0.7 & res$power[j] < 0.8) post$pwr.80[j] <- TRUE
    if (res$power[j] >= 0.8 & res$power[j] < 0.9) post$pwr.90[j] <- TRUE
    if (res$power[j] >= 0.9) post$pwr.90plus[j] <- TRUE
    if (res$lower[j] > 100 | res$upper[j] < 100) res$signif[j] <- TRUE
  }
  setTxtProgressBar(pb, j/nsims)
}
close(pb)
passed <- sum(res$BE)
cat("\nAssumed CV    :", sprintf("%.2f%%", CV),
    "\nAssumed PE    :", sprintf("%.2f%%", PE),
    "\nTarget power  :", sprintf("%.2f%%", 100*target),
    "\nSample size   :", n.des,
    "\nAchieved power:", sprintf("%.2f%%", 100*power),
    "\nDosed         :", n.adj,
    sprintf("(anticipated dropout-rate of %g%%)", 100*do.rate),
    "\n ", formatC(nsims, format = "d", big.mark = ","),
    "simulated 2\u00D72\u00D72 studies",
    "\n            CV:",
    sprintf("%5.2f \u2013 %6.2f%%", min(res$CV), max(res$CV)),
    sprintf("(geom. mean %.2f%%)", exp(mean(log(res$CV)))),
    "\n            PE:",
    sprintf("%5.2f \u2013 %6.2f%%", min(res$PE), max(res$PE)),
    sprintf("(geom. mean %.2f%%)", exp(mean(log(res$PE)))),
    "\n            n :", min(res$n), "\u2013", max(res$n),
    sprintf("(median %g)", median(res$n)),
    "\n\npassed BE (90% CI within 80.00 \u2013 125.00%):",
    sprintf("%5.2f%%", 100*passed/nsims),
    "\npercentages of passing studies",
    "\n  with \u2018post hoc\u2019 power of <50%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.50minus)/passed),
    "\n                     \u226550 \u2013 <60%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.60)/passed),
    "\n                     \u226560 \u2013 <70%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.70)/passed),
    "\n                     \u226570 \u2013 <80%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.80)/passed),
    "\n                     \u226580 \u2013 <90%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.90)/passed),
    "\n                           >90%:",
    sprintf("%5.2f%%", 100*sum(post$pwr.90plus)/passed),
    "\n  100% not within CI           :",
    sprintf("%5.2f%%", 100*sum(res$signif)/passed),
    "(\u2206 stat. significant)\n\n")


Dif-tor heh smusma 🖖
Helmut Schütz
[image]

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

Complete thread:

Activity
 Admin contact
21,371 posts in 4,463 threads, 1,496 registered users;
online 11 (0 registered, 11 guests [including 4 identified bots]).
Forum time: Sunday 21:25 CET (Europe/Vienna)

When people learn no tools of judgment
and merely follow their hopes,
the seeds of political manipulation are sown.    Stephen Jay Gould

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