Deficiencies ?? [Study Assessment]
❝ I understand your frustration.
I’m not frustrated. Just extremely 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 -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)
To quote the WHO:
- The a posteriori power of the study does not need to be calculated.
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
The quality of responses received is directly proportional to the quality of the question asked. 🚮
Science Quotes
Complete thread:
- Deficiencies ?? Helmut 2021-01-26 10:47 [Study Assessment]
- Deficiencies ?? ElMaestro 2021-01-26 12:26
- Deficiencies ??Helmut 2021-01-26 18:52
- Deficiencies ?? ElMaestro 2021-01-26 22:34
- Deficiencies ??Helmut 2021-01-26 18:52
- Deficiencies or not zizou 2021-01-31 01:07
- Deficiencies or not Helmut 2021-01-31 15:46
- Deficiencies ?? ElMaestro 2021-01-26 12:26