Deficiencies ?? [Study As­sess­ment]

posted by Helmut Homepage – Vienna, Austria, 2021-01-26 19:52 (1156 d 19:15 ago) – Posting: # 22192
Views: 2,330

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,957 posts in 4,819 threads, 1,638 registered users;
80 visitors (0 registered, 80 guests [including 9 identified bots]).
Forum time: 15:07 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