shiny app code

Author: NightlordTW

DESCRIPTION

@@ -16,6 +16,7 @@ RoxygenNote: 7.3.2
 Depends: 
     R (>= 4.1.0)
 Imports: 
+    Rcpp,
     dplyr,
     purrr,
     binom,
@@ -35,5 +36,6 @@ Suggests:
     tinytest,
     kableExtra,
     tibble
+LinkingTo: Rcpp
 SystemRequirements: JAGS (>= 4.0.0)
 Config/testthat/edition: 3

NAMESPACE

@@ -37,9 +37,13 @@ export(plot_prior_weight)
 export(posterior)
 export(power)
 export(power_fisher)
+export(run_bcts_app)
 export(sim_rct_normal)
+export(singlearm_beta_power)
+export(singlearm_beta_type1)
 export(ssre)
 import(ggplot2)
+importFrom(Rcpp,evalCpp)
 importFrom(binom,binom.confint)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,add_row)
@@ -70,3 +74,4 @@ importFrom(stats,update)
 importFrom(stats,var)
 importFrom(utils,setTxtProgressBar)
 importFrom(utils,txtProgressBar)
+useDynLib(bcts, .registration = TRUE)

R/RcppExports.R

@@ -0,0 +1,71 @@
+# Generated by using Rcpp::compileAttributes() -> do not edit by hand
+# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
+
+beta_prob_gt <- function(a, b, M, n_draws) {
+    .Call(`_bcts_beta_prob_gt`, a, b, M, n_draws)
+}
+
+#' @title Compute p-values for a t-distribution with Fixed Degrees of Freedom
+#'
+#' @description Simulates a single-arm binomial trial with a conjugate Beta prior,
+#' and computes the Bayesian power - the proportion of trials where the posterior
+#' probability that the response rate exceeds a threshold \code{M} is greater than or equal
+#' to a specified decision threshold.
+#'
+#' @param B Integer. Number of trial simulations.
+#' @param p_t Numeric in \[0, 1\]. True response probability for the treatment arm.
+#' @param n_t Integer. Sample size of the treatment arm.
+#' @param M Numeric in \[0, 1\]. Decision threshold on the response rate, e.g., \code{M = 0.6}.
+#' @param threshold Numeric in \[0, 1\]. Posterior probability cutoff for declaring success,
+#' e.g., \code{0.95}.
+#' @param prior Character string. Either \code{"flat"} for a Beta(1,1) prior or
+#' \code{"beta"} to specify a custom prior using \code{a_base} and \code{b_base}.
+#' @param a_base Numeric. Alpha parameter for the Beta prior (only used if \code{prior = "beta"}).
+#' @param b_base Numeric. Beta parameter for the Beta prior (only used if \code{prior = "beta"}).
+#' @param n_draws Integer. Number of posterior draws per trial.
+#' @param show_progress Logical. If \code{TRUE}, prints a simple progress bar to console.
+#'
+#' @return A list with: estimate (power), mc_se, successes, B.
+#'
+#' @examples
+#' singlearm_beta_power(
+#'   B = 1000, p_t = 0.75, n_t = 35, M = 0.60,
+#'   threshold = 0.95, prior = "flat", n_draws = 2000
+#' )
+#'
+#' @author Thomas Debray \email{[email protected]}
+#' @export
+singlearm_beta_power <- function(B, p_t, n_t, M, threshold, prior = "flat", a_base = 1, b_base = 1, n_draws = 2000L, show_progress = TRUE) {
+    .Call(`_bcts_singlearm_beta_power`, B, p_t, n_t, M, threshold, prior, a_base, b_base, n_draws, show_progress)
+}
+
+#' @title Estimate Type-I Error for Single-Arm Trial
+#'
+#' @description Simulates a single-arm binomial trial under the null hypothesis,
+#' and computes the type-I error: the proportion of simulations where posterior
+#' Pr(θ > M) ≥ threshold even though θ = p_null.
+#'
+#' @param B Integer. Number of simulations.
+#' @param n_t Integer. Sample size of the treatment arm.
+#' @param M Numeric. Decision threshold for θ (on probability scale, e.g., 0.6).
+#' @param threshold Posterior probability threshold γ (e.g., 0.95).
+#' @param prior "flat" or "beta".
+#' @param a_base Alpha parameter for Beta prior (if prior = "beta").
+#' @param b_base Beta parameter for Beta prior (if prior = "beta").
+#' @param n_draws Number of posterior draws per trial.
+#' @param show_progress Logical. Show progress in console?
+#'
+#' @return A list with \code{estimate} (type-I error), \code{mc_se}, \code{B}, and \code{rejections}.
+#'
+#' @examples
+#' singlearm_beta_type1(
+#'   B = 1000, n_t = 35, M = 0.6,
+#'   threshold = 0.95, prior = "flat", n_draws = 2000
+#' )
+#'
+#' @author Thomas Debray \email{[email protected]}
+#' @export
+singlearm_beta_type1 <- function(B, n_t, M, threshold, prior = "flat", a_base = 1, b_base = 1, n_draws = 2000L, show_progress = TRUE) {
+    .Call(`_bcts_singlearm_beta_type1`, B, n_t, M, threshold, prior, a_base, b_base, n_draws, show_progress)
+}
+

R/bcts_power_sat_betaBinom_conj.R

@@ -0,0 +1,22 @@
+#' Simulate Bayesian power for a single-arm binomial trial (via Rcpp)
+#'
+#' @param B Number of trial simulations.
+#' @param p_t True response probability.
+#' @param n_t Sample size.
+#' @param M Threshold for success (e.g. 0.6).
+#' @param threshold Posterior probability threshold (e.g. 0.95).
+#' @param prior Prior type: "flat" or "beta".
+#' @param a_base Alpha of Beta prior (only used if prior = "beta").
+#' @param b_base Beta of Beta prior (only used if prior = "beta").
+#' @param n_draws Number of posterior samples per trial.
+#' @param show_progress Show progress bar?
+#'
+#' @return A list with `estimate` (power), `mc_se`, `successes`, and `B`.
+#'
+#' @export
+singlearm_beta_power <- function(B, p_t, n_t, M, threshold,
+                                 prior = "flat", a_base = 1, b_base = 1,
+                                 n_draws = 2000, show_progress = TRUE) {
+  .Call(`_bcts_singlearm_beta_power`, B, p_t, n_t, M, threshold,
+        prior, a_base, b_base, n_draws, show_progress)
+}

R/bcts_type1_sat_betaBinom_conj.R

@@ -0,0 +1,21 @@
+#' Simulate Bayesian Type-I error for a single-arm binomial trial (via Rcpp)
+#'
+#' @param B Number of trial simulations.
+#' @param n_t Sample size.
+#' @param M Decision threshold (also used as null hypothesis value).
+#' @param threshold Posterior probability threshold (e.g. 0.95).
+#' @param prior Prior type: "flat" or "beta".
+#' @param a_base Alpha of Beta prior (only used if prior = "beta").
+#' @param b_base Beta of Beta prior (only used if prior = "beta").
+#' @param n_draws Number of posterior samples per trial.
+#' @param show_progress Show progress bar?
+#'
+#' @return A list with `estimate` (type-I error), `mc_se`, `rejections`, and `B`.
+#'
+#' @export
+singlearm_beta_type1 <- function(B, n_t, M, threshold,
+                                 prior = "flat", a_base = 1, b_base = 1,
+                                 n_draws = 2000, show_progress = TRUE) {
+  .Call(`_bcts_singlearm_beta_type1`, B, n_t, M, threshold,
+        prior, a_base, b_base, n_draws, show_progress)
+}

R/run_bcts_app.R

@@ -0,0 +1,28 @@
+#' Run the BCTS Shiny App
+#'
+#' Launches the interactive Shiny app included in the \code{bcts} package, which supports
+#' Bayesian clinical trial simulations for both single-arm and randomized trials. This app provides
+#' user-friendly controls to explore design parameters, power, and Type-I error.
+#'
+#' @param ... Additional arguments passed to \code{\link[shiny]{runApp}}, such as host or port.
+#' @param launch.browser Logical. Should the app be launched in the system browser? Defaults to \code{TRUE}.
+#'
+#' @details This function locates the Shiny app bundled in the \code{inst/app} directory of the
+#' \code{bcts} package and runs it using \code{shiny::runApp}. Ensure that the package was installed
+#' with the app directory included.
+#'
+#' @return None. This function is called for its side effect of launching the app.
+#'
+#' @examples
+#' if (interactive()) {
+#'   run_bcts_app()
+#' }
+#'
+#' @export
+run_bcts_app <- function(..., launch.browser = TRUE) {
+  app_dir <- system.file("app", package = "bcts")
+  if (app_dir == "") {
+    stop("App not found. Try reinstalling the bcts package.", call. = FALSE)
+  }
+  shiny::runApp(app_dir, launch.browser = launch.browser, ...)
+}

R/zzz.R

@@ -0,0 +1,3 @@
+#' @useDynLib bcts, .registration = TRUE
+#' @importFrom Rcpp evalCpp
+NULL

inst/app/R/ui_rct_decision_criteria.R

@@ -0,0 +1,56 @@
+# inst/app/R/ui_rct_decision_criteria.R
+
+decision_criteria_ui <- function(id = NULL) {
+  ns <- NS(id)  # allows modular usage, or just use identity
+
+  wellPanel(
+    h4("Decision criteria"),
+    sliderInput(
+      ns("M"),
+      label = HTML("Decision Margin (\\( \\Delta \\))"),
+      min   = -100, max = 100, value = -20, step = 1, post = "%"
+    ),
+    helpText(
+      "Δ < 0: non-inferiority (treatment may be up to |Δ| worse).",
+      "Δ ≥ 0: superiority (treatment must be at least Δ better).",
+      "Assumes higher response rates are better (responder events)."
+    ),
+
+    radioButtons(ns("decision_mode"), "Threshold specification:",
+                 choices = c(
+                   "Specify posterior probability threshold γ" = "gamma",
+                   "Specify target Type-I error α" = "alpha"
+                 ),
+                 selected = "gamma"),
+
+    conditionalPanel(
+      condition = sprintf("input['%s'] == 'gamma'", ns("decision_mode")),
+      sliderInput(
+        ns("gamma"),
+        label = HTML("Posterior probability threshold (\\( \\gamma \\))"),
+        min = 80, max = 99, value = 90, step = 1, post = "%"
+      ),
+      uiOutput(ns("decision_rule"))
+    ),
+
+    conditionalPanel(
+      condition = sprintf("input['%s'] == 'alpha'", ns("decision_mode")),
+      sliderInput(
+        ns("alpha"),
+        label = HTML("Target Type-I error (\\( \\alpha \\))"),
+        value = 10, min = 1, max = 20, step = 1, post = "%"
+      ),
+      selectInput(
+        ns("calibrate_on"),
+        "Calibrate Type-I on:",
+        choices = c(
+          "Point estimate Pr(reject | H₀)" = "point",
+          "Upper 95% MC CI (conservative)" = "upper",
+          "Lower 95% MC CI (liberal)"      = "lower"
+        ),
+        selected = "upper"
+      ),
+      helpText("γ will be calibrated so that the chosen Type-I metric ≈ α (within tolerance) at the least-favourable null.")
+    )
+  )
+}

inst/app/R/ui_sat_decision_criteria.R

@@ -0,0 +1,63 @@
+# inst/app/R/ui_sat_decision_criteria.R
+
+sat_decision_criteria_ui <- function(id = NULL) {
+  ns <- NS(id)
+
+  wellPanel(
+    h4("Decision Criteria"),
+
+    sliderInput(
+      ns("M_sa"),
+      label = HTML("Decision Margin (\\( M \\))"),
+      min = 0, max = 100, value = 65, step = 1, post = "%"
+    ),
+
+    helpText(
+      "Define the threshold on the response rate (M) that must be exceeded to declare success.",
+      "Higher values make the design more stringent."
+    ),
+
+    radioButtons(
+      ns("decision_mode_sa"),
+      label = "Threshold Specification Method:",
+      choices = c(
+        "Specify posterior probability threshold (\\( \\gamma \\))" = "gamma",
+        "Specify target Type-I error (\\( \\alpha \\))" = "alpha"
+      ),
+      selected = "gamma"
+    ),
+
+    conditionalPanel(
+      condition = sprintf("input['%s'] == 'gamma'", ns("decision_mode_sa")),
+      sliderInput(
+        ns("gamma_sa"),
+        label = HTML("Posterior probability threshold (\\( \\gamma \\))"),
+        min = 80, max = 99, value = 90, step = 1, post = "%"
+      ),
+      uiOutput(ns("decision_rule"))
+    ),
+
+    conditionalPanel(
+      condition = sprintf("input['%s'] == 'alpha'", ns("decision_mode_sa")),
+      sliderInput(
+        ns("alpha_sa"),
+        label = HTML("Target Type-I error (\\( \\alpha \\))"),
+        min = 1, max = 20, value = 10, step = 1, post = "%"
+      ),
+      selectInput(
+        ns("calibrate_on_sa"),
+        label = "Calibrate Type-I error based on:",
+        choices = c(
+          "Point estimate Pr(reject | H₀)"      = "point",
+          "Upper 95% MC CI (conservative)"      = "upper",
+          "Lower 95% MC CI (liberal)"           = "lower"
+        ),
+        selected = "upper"
+      ),
+      helpText(
+        "The threshold γ will be calibrated such that the chosen Type-I error metric",
+        "approximates α at the least-favorable null scenario."
+      )
+    )
+  )
+}