Skip to content

Commit d3c80dd

Browse files
NightlordTWNightlordTW
committed
Add info
1 parent c87b4d9 commit d3c80dd

File tree

4 files changed

+258
-99
lines changed

4 files changed

+258
-99
lines changed

‎inst/app/app.R‎

Lines changed: 40 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -7,15 +7,15 @@ library(ggplot2)
77
library(bcts)
88

99
# Helper to source R files from inst/app/R and inst/app/modules
10-
source_dir <- function(path) {
10+
source_dir <- function(path, recursive = TRUE) {
1111
if (dir.exists(path)) {
12-
fs <- list.files(path, pattern = "\\.R$", full.names = TRUE)
12+
fs <- list.files(path, pattern = "\\.R$", full.names = TRUE, recursive = recursive)
1313
for (f in fs) {
14-
message("Sourcing: ", basename(f))
14+
message("Sourcing: ", f)
1515
tryCatch({
16-
source(f, local = globalenv()) # Use globalenv for visibility
16+
source(f, local = globalenv()) # globalenv ensures visibility across app
1717
}, error = function(e) {
18-
message("Error sourcing ", f, ": ", e$message)
18+
message("❌ Error sourcing ", f, ": ", e$message)
1919
})
2020
}
2121
}
@@ -38,6 +38,7 @@ source_dir(file.path(app_dir, "modules"))
3838

3939
ui <- navbarPage(
4040
title = "Bayesian Trial Simulation (Beta–Binomial, conjugate)",
41+
mod_info_ui("info"),
4142
tabPanel(
4243
title = "Randomized trial",
4344
fluidPage(
@@ -133,10 +134,6 @@ ui <- navbarPage(
133134

134135
actionButton("run", "Run simulation", class = "btn-primary"),
135136

136-
hr(),
137-
tags$small(
138-
paste("bcts version:", utils::packageVersion("bcts"))
139-
)
140137
),
141138
mainPanel(
142139
conditionalPanel(
@@ -162,51 +159,12 @@ ui <- navbarPage(
162159
)
163160
),
164161

165-
tabPanel(
166-
title = "Single-arm trial",
167-
fluidPage(
168-
h4("Simulate a single-arm trial with a Bayesian decision rule"),
169-
p("This section will allow evaluation of single-arm designs using Beta–Binomial conjugate models."),
170-
p("You can simulate a posterior for a single group, compare against a threshold, or incorporate external data via power priors."),
171-
br(),
172-
sidebarLayout(
173-
sidebarPanel(
174-
h4("Design settings"),
175-
176-
sliderInput("pt_sa", HTML("True response rate (\\( \\theta_t \\))"),
177-
min = 0, max = 100, value = 80, step = 1, post = "%"),
178-
179-
numericInput("nt_sa", HTML("Sample size (\\( n_t \\))"),
180-
value = 40, min = 1, step = 1),
181-
182-
selectInput(
183-
"prior_sa",
184-
"Prior distribution",
185-
choices = c("Flat (Beta(1,1))" = "flat",
186-
"Custom Beta prior" = "beta"),
187-
selected = "flat"
188-
),
189-
190-
conditionalPanel(
191-
condition = "input.prior_sa == 'beta'",
192-
numericInput("abase_sa", "Prior a_base", value = 1, min = 0.01, step = 0.1),
193-
numericInput("bbase_sa", "Prior b_base", value = 1, min = 0.01, step = 0.1)
194-
),
195-
196-
sat_decision_criteria_ui("crit_sa"),
197-
),
198-
199-
mainPanel(
200-
verbatimTextOutput("sa_summary"),
201-
plotOutput("sa_power_plot")
202-
)
203-
)
204-
)
205-
)
162+
mod_singlearm_ui("singlearm")
206163
)
207164

208165
server <- function(input, output, session) {
209166

167+
210168
output$decision_rule <- renderUI({
211169
withMathJax( # <- ensure newly injected HTML is typeset
212170
helpText(HTML(sprintf(
@@ -375,7 +333,7 @@ server <- function(input, output, session) {
375333
pc_current = reactive(input$pc) # for pre-filling the range nicely
376334
)
377335

378-
sa_results <- reactive({
336+
observeEvent(input$run_sa, {
379337
req(input$pt_sa, input$nt_sa,
380338
input[["crit_sa-M_sa"]],
381339
input[["crit_sa-gamma_sa"]])
@@ -392,55 +350,42 @@ server <- function(input, output, session) {
392350
M <- input[["crit_sa-M_sa"]] / 100
393351
gamma <- input[["crit_sa-gamma_sa"]] / 100
394352

395-
power_res <- bcts::singlearm_beta_power(
396-
B = B,
397-
p_t = pt,
398-
n_t = input$nt_sa,
399-
M = M,
400-
threshold = gamma,
401-
prior = prior_type,
402-
a_base = a_base,
403-
b_base = b_base,
404-
method = "exact",
405-
show_progress = FALSE
406-
)
353+
withProgress(message = "Running single-arm simulations...", {
354+
power_res <- bcts::singlearm_beta_power(
355+
B = B,
356+
p_t = pt,
357+
n_t = input$nt_sa,
358+
M = M,
359+
threshold = gamma,
360+
prior = prior_type,
361+
a_base = a_base,
362+
b_base = b_base,
363+
#n_draws = n_draws,
364+
method = "exact",
365+
show_progress = FALSE
366+
)
367+
368+
type1_res <- bcts::singlearm_beta_type1(
369+
B = B,
370+
n_t = input$nt_sa,
371+
M = M,
372+
threshold = gamma,
373+
prior = prior_type,
374+
a_base = a_base,
375+
b_base = b_base,
376+
n_draws = n_draws,
377+
show_progress = FALSE
378+
)
407379

408-
type1_res <- bcts::singlearm_beta_type1(
409-
B = B,
410-
n_t = input$nt_sa,
411-
M = M,
412-
threshold = gamma,
413-
prior = prior_type,
414-
a_base = a_base,
415-
b_base = b_base,
416-
n_draws = n_draws,
417-
method = "exact",
418-
show_progress = FALSE
419-
)
420380

421-
list(power = power_res, type1 = type1_res)
422-
})
423381

424-
output$sa_summary <- renderPrint({
425-
res <- sa_results()
426-
power_res <- res$power
427-
type1_res <- res$type1
428-
429-
cat("POWER ANALYSIS\n")
430-
cat(sprintf("Estimated power: %.2f%%\n", 100 * power_res$estimate))
431-
cat(sprintf("MC standard error: %.2f%%\n", 100 * power_res$mc_se %||% NA_real_))
432-
cat(sprintf("Successes: %d out of %d simulations\n\n",
433-
power_res$successes %||% NA_integer_,
434-
power_res$B %||% NA_integer_))
435-
436-
cat("TYPE-I ERROR ANALYSIS\n")
437-
cat(sprintf("Estimated Type-I error: %.2f%%\n", 100 * type1_res$estimate))
438-
cat(sprintf("MC standard error: %.2f%%\n", 100 * type1_res$mc_se %||% NA_real_))
439-
cat(sprintf("False positives: %d out of %d simulations\n",
440-
type1_res$successes %||% NA_integer_,
441-
type1_res$B %||% NA_integer_))
382+
383+
})
442384
})
443385

386+
mod_singlearm_server("singlearm") # server logic for single-arm studies
387+
mod_info_server("info")
388+
444389
}
445390

446391
tryCatch(

‎inst/app/modules/info/mod_info_ui.R‎

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
#' @title Info UI Module
2+
#' @description UI for version and basic info
3+
#' @export
4+
mod_info_ui <- function(id) {
5+
ns <- NS(id)
6+
7+
tabPanel(
8+
title = "Info",
9+
fluidPage(
10+
h4("About this app"),
11+
p("This application allows simulation and evaluation of Bayesian trial designs using conjugate Beta–Binomial models."),
12+
p("It supports both randomized trials and single-arm studies with optional historical borrowing."),
13+
br(),
14+
h5("Version info"),
15+
verbatimTextOutput(ns("version_text"))
16+
)
17+
)
18+
}
19+
20+
#' @title Info Server Module
21+
#' @description Displays package version info
22+
#' @export
23+
mod_info_server <- function(id) {
24+
moduleServer(id, function(input, output, session) {
25+
ns <- session$ns
26+
27+
output$version_text <- renderText({
28+
paste("bcts version:", as.character(utils::packageVersion("bcts")))
29+
})
30+
})
31+
}

‎inst/app/modules/mod_narrative.R‎

Lines changed: 8 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -61,12 +61,16 @@ mod_narrative_server <- function(
6161
prior(),
6262
"flat" = "a non-informative flat prior for the response rate in each arm",
6363
"power" = {
64-
eff_n0 <- prior_args()$a0 * prior_args()$n_0
64+
a0 <- prior_args()$a0 %||% 0
65+
n_0 <- prior_args()$n_0 %||% 1
66+
y_0 <- prior_args()$y_0 %||% 0
67+
eff_n0 <- a0 * n_0
68+
6569
sprintf(
6670
"a power prior incorporating %s/%s historical responders. The historical data is down-weighted using a factor of %.0f%%, resulting in an effective contribution equivalent to %.1f patients",
67-
fmt_int(prior_args()$y_0),
68-
fmt_int(prior_args()$n_0),
69-
100 * prior_args()$a0,
71+
fmt_int(y_0),
72+
fmt_int(n_0),
73+
100 * a0,
7074
eff_n0
7175
)
7276
}

0 commit comments

Comments
 (0)