Skip to content

Commit f5981cd

Browse files
NightlordTWNightlordTW
committed
avoid testing using rjags
1 parent 339d1f0 commit f5981cd

File tree

4 files changed

+99
-63
lines changed

4 files changed

+99
-63
lines changed

‎inst/app/modules/mod_designsummary.R‎

Lines changed: 17 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -14,13 +14,15 @@ mod_designsummary_ui <- function(id) {
1414

1515
mod_designsummary_server <- function(
1616
id,
17+
# DGM (truths & sizes)
1718
pt, nt,
1819
pc, nc,
19-
M,
20+
# Analysis model
2021
prior,
21-
prior_args, # list(a0 in [0,1], y_0, n_0, a_base, b_base)
22-
decision_mode,
23-
gamma, alpha, calibrate_on,
22+
prior_args, # list(a0, y_0, n_0, a_base, b_base)
23+
# Decision/calibration
24+
M, decision_mode, gamma, alpha, calibrate_on,
25+
# Simulation controls
2426
B, ndraws, seed
2527
) {
2628
moduleServer(id, function(input, output, session) {
@@ -63,7 +65,7 @@ mod_designsummary_server <- function(
6365

6466
decision_txt <- if (identical(vals$mode, "gamma")) {
6567
sprintf(
66-
"Success if \\(\\Pr(\\hat{\\theta}_t - \\hat{\\theta}_c > %s)\\ \\ge\\ %s\\).",
68+
"Success if \\(\\Pr({\\theta}_t - {\\theta}_c > %s)\\ \\ge\\ %s\\).",
6769
mjax_pct(vals$M, 0), mjax_pct(vals$gamma, 0)
6870
)
6971
} else {
@@ -123,27 +125,21 @@ mod_designsummary_server <- function(
123125
# -------------------------------------------------------------------------------
124126

125127
html <- paste0(
126-
"<details open>",
127-
"<summary><h4>Design summary</h4></summary>",
128-
"<div style='margin-top:.6rem'>",
129-
"<p><strong>Design:</strong> Binary endpoint with Beta–Binomial conjugate updates.</p>",
128+
"<details open><summary><h4>Design summary</h4></summary><div>",
129+
"<h5>Data-generating assumptions</h5>",
130130
"<ul>",
131-
"<li><b>Assumed truths</b>: ",
132-
"\\(\\theta_t = ", mjax_pct(vals$pt, 0), "\\), ",
133-
"\\(\\theta_c = ", mjax_pct(vals$pc, 0), "\\)",
134-
"</li>",
135-
"<li><b>Sample sizes</b>: treatment \\(n_t = ", vals$nt,
131+
"<li><b>Truths:</b> \\(\\theta_t = ", mjax_pct(vals$pt,0),
132+
"\\), \\(\\theta_c = ", mjax_pct(vals$pc,0), "\\)</li>",
133+
"<li><b>Sample sizes:</b> treatment \\(n_t = ", vals$nt,
136134
"\\), control \\(n_c = ", vals$nc, "\\)</li>",
137-
"<li><b>Margin</b>: \\(\\Delta = ", mjax_pct(vals$M, 0), "\\) ",
138-
"(Δ &lt; 0 non-inferiority; Δ ≥ 0 superiority)</li>",
139-
"<li><b>Prior</b>: ", prior_txt, "</li>",
140-
"<li><b>Decision rule</b>: ", decision_txt, "</li>",
141-
"<li><b>Simulation setup</b>: ", sim_txt, "</li>",
142135
"</ul>",
143136

144-
# Collapsible model equations with configured numbers
145-
"<h5 style='margin-top:.5rem'>Model (likelihood &amp; prior)</h5>",
137+
"<h5>Analysis model (likelihood & prior)</h5>",
146138
lik_eq, prior_eq,
139+
140+
"<h5>Decision rule</h5><p>", decision_txt, "</p>",
141+
142+
"<h5>Simulation setup</h5><p>", sim_txt, "</p>",
147143
"</div>",
148144
"</details>"
149145
)

‎tests/testthat.r‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
library(testthat)
22
library(binom)
3-
library(rjags)
43

54
# test_check("bcts")

‎tests/testthat/test-dose_selection.r‎

Lines changed: 78 additions & 39 deletions
Original file line numberDiff line numberDiff line change
@@ -1,54 +1,93 @@
1-
require(rjags)
2-
3-
test_that("Test dose selection at interim", {
4-
nsim <- 1000
5-
alpha <- 0.05
6-
1+
test_that("Dose selection at interim (frequentist)", {
2+
nsim <- 1000
3+
alpha <- 0.05
74
trt_ref <- "Placebo"
8-
n_pln <- 20 + 65*2
5+
trt_act <- c("Drug A", "Drug B")
6+
n_pln <- 20 + 65*2
97
th.fut <- 0.2
108
th.eff <- 0.9
11-
th.prom <- 0.5
129

10+
rejectH0_freq <- matrix(FALSE, nrow = nsim, ncol = length(trt_act),
11+
dimnames = list(NULL, trt_act))
1312

14-
rejectH0 <- data.frame(freq = logical(), bayes = logical())
13+
for (i in seq_len(nsim)) {
14+
dat_int <- sim_rct_normal(
15+
n = 20*3,
16+
mean = c("Placebo" = 0, "Drug A" = 0, "Drug B" = 0),
17+
sd = c("Placebo" = 1, "Drug A" = 1, "Drug B" = 1)
18+
)
1519

16-
for (i in 1:nsim) {
20+
res <- dose_selection(
21+
dat_int = dat_int,
22+
n_pln = n_pln,
23+
trt_ref = trt_ref,
24+
trt_active = trt_act,
25+
gamma = 1 - alpha/2,
26+
th.fut = th.fut,
27+
th.eff = th.eff,
28+
method = "mcmc"
29+
)
1730

18-
# Simulate trial data at interim stage
19-
dat_int <- sim_rct_normal(n = 20*3,
20-
mean = c("Placebo" = 0, "Drug A" = 0, "Drug B" = 0),
21-
sd = c("Placebo" = 1, "Drug A" = 1, "Drug B" = 1))
31+
rej <- res$rejectH0
32+
# normalize to named logical vector over trt_act
33+
if (is.logical(rej) && length(rej) == 1L) rej <- setNames(rep(rej, length(trt_act)), trt_act)
34+
if (is.null(names(rej))) names(rej) <- trt_act
35+
rejectH0_freq[i, ] <- as.logical(rej[trt_act])
36+
}
2237

23-
resultf <- dose_selection(dat_int = dat_int,
24-
n_pln = n_pln,
25-
trt_ref = "Placebo",
26-
trt_active = c("Drug A", "Drug B"),
27-
gamma = 1 - alpha/2,
28-
th.fut = th.fut, th.eff = th.eff,
29-
method = "mcmc")
38+
for (arm in trt_act) {
39+
ci <- mc_error_proportion(x = sum(rejectH0_freq[, arm]),
40+
n = nsim, level = 1 - alpha)
41+
expect_true(alpha >= ci$lower & alpha <= ci$upper,
42+
info = paste0("Type-I error not maintained (freq, ", arm, "): ",
43+
round(ci$lower, 4), "–", round(ci$upper, 4)))
44+
}
45+
})
3046

31-
resultb <- dose_selection(dat_int = dat_int,
32-
n_pln = n_pln,
33-
trt_ref = "Placebo",
34-
trt_active = c("Drug A", "Drug B"),
35-
gamma = 1 - alpha/2,
36-
th.fut = th.fut, th.eff = th.eff,
37-
method = "bayes")
47+
test_that("Dose selection at interim (Bayesian)", {
48+
skip_if_not_installed("rjags")
3849

39-
rejectH0 <- rejectH0 %>% add_row(data.frame(freq = resultf$rejectH0, bayes = resultb$rejectH0))
40-
}
50+
nsim <- 1000
51+
alpha <- 0.05
52+
trt_ref <- "Placebo"
53+
trt_act <- c("Drug A", "Drug B")
54+
n_pln <- 20 + 65*2
55+
th.fut <- 0.2
56+
th.eff <- 0.9
57+
58+
rejectH0_bayes <- matrix(FALSE, nrow = nsim, ncol = length(trt_act),
59+
dimnames = list(NULL, trt_act))
4160

42-
# Test whether type-I error is controlled
43-
treat.ci <- mc_error_proportion(x = sum(rejectH0$freq), n = nsim, level = 1 - alpha)
44-
expect_true(alpha >= treat.ci$lower & alpha <= treat.ci$upper,
45-
info = paste0("Type-I error for treat is not maintained for frequentist analysis (",
46-
round(treat.ci$lower,4), "; ", round(treat.ci$upper,4), ")"))
61+
for (i in seq_len(nsim)) {
62+
dat_int <- sim_rct_normal(
63+
n = 20*3,
64+
mean = c("Placebo" = 0, "Drug A" = 0, "Drug B" = 0),
65+
sd = c("Placebo" = 1, "Drug A" = 1, "Drug B" = 1)
66+
)
4767

48-
treat.ci <- mc_error_proportion(x = sum(rejectH0$bayes), n = nsim, level = 1 - alpha)
49-
expect_true(alpha >= treat.ci$lower & alpha <= treat.ci$upper,
50-
info = paste0("Type-I error for treat is not maintained for Bayesian analysis (",
51-
round(treat.ci$lower,4), "; ", round(treat.ci$upper,4), ")"))
68+
res <- dose_selection(
69+
dat_int = dat_int,
70+
n_pln = n_pln,
71+
trt_ref = trt_ref,
72+
trt_active = trt_act,
73+
gamma = 1 - alpha/2,
74+
th.fut = th.fut,
75+
th.eff = th.eff,
76+
method = "bayes"
77+
)
5278

79+
rej <- res$rejectH0
80+
if (is.logical(rej) && length(rej) == 1L) rej <- setNames(rep(rej, length(trt_act)), trt_act)
81+
if (is.null(names(rej))) names(rej) <- trt_act
82+
rejectH0_bayes[i, ] <- as.logical(rej[trt_act])
83+
}
5384

85+
for (arm in trt_act) {
86+
ci <- mc_error_proportion(x = sum(rejectH0_bayes[, arm]),
87+
n = nsim, level = 1 - alpha)
88+
expect_true(alpha >= ci$lower & alpha <= ci$upper,
89+
info = paste0("Type-I error not maintained (Bayes, ", arm, "): ",
90+
round(ci$lower, 4), "–", round(ci$upper, 4)))
91+
}
5492
})
93+

‎tests/testthat/test-eval_superiority.r‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
1-
require(rjags)
2-
31
test_that("Test type-I error control for traditional RCT", {
2+
skip_if_not_installed("rjags")
3+
44
nsim <- 10000
55
alpha <- 0.05
66

@@ -44,6 +44,8 @@ test_that("Test type-I error control for traditional RCT", {
4444
})
4545

4646
test_that("Test power for traditional RCT", {
47+
skip_if_not_installed("rjags")
48+
4749
nsim <- 10000
4850
alpha <- 0.05
4951

0 commit comments

Comments
 (0)