Deficiencies ?? [Study As­sess­ment]

posted by Helmut Homepage – Vienna, Austria, 2021-01-26 19:52 (1175 d 10:36 ago) – Posting: # 22192
Views: 2,393

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 🖖🏼 Довге життя Україна! [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,984 posts in 4,822 threads, 1,650 registered users;
43 visitors (0 registered, 43 guests [including 5 identified bots]).
Forum time: 07:28 CEST (Europe/Vienna)

You can’t fix by analysis
what you bungled by design.    Richard J. Light, Judith D. Singer, John B. Willett

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