Live Demos
These are real Shiny apps, compiled to WebAssembly with Shinylive and served as static files — the same technology stack we use for client dashboards, minus the server. The first load downloads the R runtime (~15 MB), so give it a few seconds.
Looking for the visual overview? Browse the demo gallery.
Interactive statistics
1. Two-group comparison simulator
Move the sliders and watch the t-test react. Notice how small samples make even a real effect easy to miss.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 560
library(shiny)
ui <- fluidPage(
tags$style(HTML("
h4 { color:#1b2a4a; font-weight:700; }
.irs-bar, .irs-handle { border-color:#2f6fed; background:#2f6fed; }
")),
h4("Simulate a two-group study"),
fluidRow(
column(4, sliderInput("n", "Participants per group", 5, 100, 20, step = 5)),
column(4, sliderInput("d", "True effect size (Cohen's d)", 0, 1.5, 0.5, step = 0.1)),
column(4, br(), actionButton("resample", "Draw a new sample", class = "btn-primary"))
),
plotOutput("plot", height = "320px"),
htmlOutput("result")
)
server <- function(input, output, session) {
dat <- reactive({
input$resample
n <- input$n
data.frame(
group = rep(c("Control", "Treatment"), each = n),
score = c(rnorm(n, 0, 1), rnorm(n, input$d, 1))
)
})
output$plot <- renderPlot({
d <- dat()
par(mar = c(4, 4, 1, 1), family = "sans")
boxplot(score ~ group, data = d, col = c("#2f6fed22", "#17a2b822"),
border = "#1b2a4a", outline = FALSE,
xlab = "", ylab = "Score", frame = FALSE)
pts <- jitter(as.numeric(factor(d$group)), amount = 0.12)
points(pts, d$score, pch = 19, cex = 0.8,
col = ifelse(d$group == "Control", "#2f6fed88", "#17a2b888"))
})
output$result <- renderUI({
d <- dat()
tt <- t.test(score ~ group, data = d)
sds <- tapply(d$score, d$group, sd)
ms <- tapply(d$score, d$group, mean)
d_obs <- (ms[2] - ms[1]) / sqrt(mean(sds^2))
sig <- tt$p.value < 0.05
HTML(sprintf(
"<p style='font-size:1.05rem'>t(%.1f) = %.2f, p = %s, observed d = %.2f — <b style='color:%s'>%s</b></p>",
tt$parameter, -tt$statistic,
ifelse(tt$p.value < .001, "< .001", sprintf("%.3f", tt$p.value)),
d_obs,
ifelse(sig, "#17a2b8", "#b02a37"),
ifelse(sig, "statistically significant at α = .05",
"not statistically significant at α = .05")
))
})
}
shinyApp(ui, server)
2. Power curve explorer
The planning question every study should start with: how many participants do I need?
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 540
library(shiny)
ui <- fluidPage(
tags$style(HTML("h4 { color:#1b2a4a; font-weight:700; }")),
h4("Power for a two-group t-test"),
fluidRow(
column(4, sliderInput("d", "Assumed effect size (d)", 0.1, 1.2, 0.5, step = 0.05)),
column(4, selectInput("alpha", "Significance level α",
c("0.05" = 0.05, "0.01" = 0.01), selected = 0.05)),
column(4, sliderInput("target", "Target power", 0.5, 0.95, 0.8, step = 0.05))
),
plotOutput("curve", height = "330px"),
htmlOutput("answer")
)
server <- function(input, output, session) {
n_needed <- reactive({
ceiling(power.t.test(delta = input$d, sig.level = as.numeric(input$alpha),
power = input$target)$n)
})
output$curve <- renderPlot({
ns <- seq(5, 200, by = 1)
pw <- sapply(ns, function(n)
power.t.test(n = n, delta = input$d,
sig.level = as.numeric(input$alpha))$power)
par(mar = c(4.5, 4.5, 1, 1), family = "sans")
plot(ns, pw, type = "l", lwd = 3, col = "#2f6fed", ylim = c(0, 1),
xlab = "Participants per group", ylab = "Power", frame = FALSE)
abline(h = input$target, lty = 2, col = "#1b2a4a")
abline(v = n_needed(), lty = 2, col = "#17a2b8")
points(n_needed(), input$target, pch = 19, cex = 1.4, col = "#17a2b8")
})
output$answer <- renderUI({
HTML(sprintf(
"<p style='font-size:1.05rem'>To detect <b>d = %.2f</b> with %.0f%% power at α = %s you need ≈ <b style='color:#17a2b8'>%d participants per group</b> (%d in total).</p>",
input$d, input$target * 100, input$alpha, n_needed(), 2 * n_needed()
))
})
}
shinyApp(ui, server)
3. What “95% confidence” actually means
Each vertical line is a confidence interval from a fresh sample of the same population. Intervals that miss the true mean (dashed line) are shown in red — in the long run, about 5% of them at the 95% level.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 540
library(shiny)
ui <- fluidPage(
tags$style(HTML("h4 { color:#1b2a4a; font-weight:700; }")),
h4("100 confidence intervals, 100 fresh samples"),
fluidRow(
column(4, sliderInput("n", "Sample size per study", 5, 100, 20, step = 5)),
column(4, sliderInput("conf", "Confidence level", 0.80, 0.99, 0.95, step = 0.01)),
column(4, br(), actionButton("go", "Resample all 100", class = "btn-primary"))
),
plotOutput("cis", height = "330px"),
htmlOutput("coverage")
)
server <- function(input, output, session) {
sims <- reactive({
input$go
t(replicate(100, {
x <- rnorm(input$n, mean = 50, sd = 10)
tt <- t.test(x, conf.level = input$conf)
c(tt$conf.int[1], tt$conf.int[2])
}))
})
output$cis <- renderPlot({
ci <- sims()
miss <- ci[, 1] > 50 | ci[, 2] < 50
par(mar = c(4, 4.5, 1, 1), family = "sans")
plot(NA, xlim = c(1, 100), ylim = range(ci),
xlab = "Study number", ylab = "Estimated mean", frame = FALSE)
segments(1:100, ci[, 1], 1:100, ci[, 2],
col = ifelse(miss, "#b02a37", "#2f6fed88"), lwd = 2)
abline(h = 50, lty = 2, lwd = 2, col = "#1b2a4a")
})
output$coverage <- renderUI({
ci <- sims()
hits <- mean(ci[, 1] <= 50 & ci[, 2] >= 50)
HTML(sprintf(
"<p style='font-size:1.05rem'>This round, <b style='color:#17a2b8'>%.0f%%</b> of the %.0f%% intervals captured the true mean. Resample to see the long-run behaviour.</p>",
hits * 100, input$conf * 100
))
})
}
shinyApp(ui, server)
4. Diagnostic test calculator
A test’s sensitivity and specificity are fixed, but its predictive values are not — they swing with how common the disease is. Set the test’s properties and the prevalence, and watch the positive and negative predictive values respond.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 560
library(shiny)
ui <- fluidPage(
tags$style(HTML("h4 { color:#1b2a4a; font-weight:700; }
.irs-bar, .irs-handle { border-color:#2f6fed; background:#2f6fed; }")),
h4("Predictive values vs. disease prevalence"),
fluidRow(
column(4, sliderInput("sens", "Sensitivity", 0.50, 0.999, 0.90, step = 0.01)),
column(4, sliderInput("spec", "Specificity", 0.50, 0.999, 0.95, step = 0.01)),
column(4, sliderInput("prev", "Disease prevalence", 0.001, 0.50, 0.10, step = 0.005))
),
plotOutput("curve", height = "320px"),
htmlOutput("result")
)
server <- function(input, output, session) {
ppv <- function(sens, spec, p) (sens * p) / (sens * p + (1 - spec) * (1 - p))
npv <- function(sens, spec, p) (spec * (1 - p)) / (spec * (1 - p) + (1 - sens) * p)
output$curve <- renderPlot({
ps <- seq(0.001, 0.6, length.out = 200)
par(mar = c(4.5, 4.5, 1, 1), family = "sans")
plot(ps, ppv(input$sens, input$spec, ps), type = "l", lwd = 3,
col = "#2f6fed", ylim = c(0, 1), xlab = "Disease prevalence",
ylab = "Predictive value", frame = FALSE)
lines(ps, npv(input$sens, input$spec, ps), lwd = 3, col = "#17a2b8")
abline(v = input$prev, lty = 2, col = "#1b2a4a")
legend("right", c("PPV", "NPV"), col = c("#2f6fed", "#17a2b8"),
lwd = 3, bty = "n")
})
output$result <- renderUI({
v_ppv <- ppv(input$sens, input$spec, input$prev)
v_npv <- npv(input$sens, input$spec, input$prev)
lr_pos <- input$sens / (1 - input$spec)
lr_neg <- (1 - input$sens) / input$spec
HTML(sprintf(
"<p style='font-size:1.05rem'>At <b>%.1f%%</b> prevalence: PPV = <b style='color:#2f6fed'>%.1f%%</b>, NPV = <b style='color:#17a2b8'>%.1f%%</b>. Likelihood ratios: LR+ = %.1f, LR− = %.2f.</p>",
input$prev * 100, v_ppv * 100, v_npv * 100, lr_pos, lr_neg
))
})
}
shinyApp(ui, server)
Clinical reporting
5. Table 1 explorer with gtsummary
Build a publication-ready Table 1 from a clinical-trial dataset without writing any code. Choose the grouping variable and which characteristics to include, and the gtsummary table rebuilds itself. This app loads gtsummary and its dependencies into your browser, so give the first run a little longer. Prefer to see and edit the code? Try the editable gtsummary demo instead, and learn the syntax in our step-by-step tutorial.
#| '!! shinylive warning !!': |
#| shinylive does not work in self-contained HTML documents.
#| Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 720
library(shiny)
library(gtsummary)
var_choices <- c("Age" = "age", "Marker (ng/mL)" = "marker",
"T stage" = "stage", "Grade" = "grade",
"Tumor response" = "response")
ui <- fluidPage(
tags$style(HTML("h4 { color:#1b2a4a; font-weight:700; }
.well, .form-group { margin-bottom:10px; }")),
h4("Build a Table 1 from clinical trial data"),
fluidRow(
column(4, selectInput("by", "Group by",
c("Treatment" = "trt", "T stage" = "stage",
"Grade" = "grade", "(no grouping)" = "none"),
selected = "trt")),
column(4, checkboxGroupInput("vars", "Include characteristics",
choices = var_choices,
selected = c("age", "marker", "stage", "grade"))),
column(4,
checkboxInput("addp", "Add p-value (compare groups)", TRUE),
checkboxInput("overall", "Add overall column", FALSE))
),
hr(),
uiOutput("tbl")
)
server <- function(input, output, session) {
output$tbl <- renderUI({
inc <- input$vars
if (is.null(inc) || length(inc) == 0)
return(HTML("<p>Select at least one characteristic above.</p>"))
by <- input$by
dat <- gtsummary::trial
# gtsummary can't include the grouping variable among the summarised ones
if (by != "none") inc <- setdiff(inc, by)
if (length(inc) == 0)
return(HTML("<p>Pick a characteristic other than the grouping variable.</p>"))
t <- if (by == "none") {
tbl_summary(dat, include = tidyselect::all_of(inc))
} else {
tbl_summary(dat, by = tidyselect::all_of(by),
include = tidyselect::all_of(inc))
}
if (isTRUE(input$addp) && by != "none") t <- add_p(t)
if (isTRUE(input$overall) && by != "none") t <- add_overall(t)
t <- bold_labels(t)
HTML(as.character(gt::as_raw_html(as_gt(t))))
})
}
shinyApp(ui, server)
Want a dashboard like this wired to your own data — with a real server, authentication and automated updates? That’s our Shiny practice.