Nothing
Report: Sample size planning for sequential ANOVAs"
In sprtt: Sequential Probability Ratio Tests Toolbox
# DO NOT RUN
# This code generates the html.file so the icon in the browser is the sprtt logo
# Read and encode favicon
favicon_base64 <- base64enc::base64encode("pkgdown/favicon/favicon.ico")
# Create the HTML content
html_content <- sprintf(
'<link rel="shortcut icon" href="data:image/x-icon;base64,%s" type="image/x-icon" />',
favicon_base64
)
# Write to file in the skeleton folder
writeLines(
html_content,
"inst/rmarkdown/templates/report_sample_size/skeleton/favicon.html"
)
knitr::opts_chunk$set(warning = FALSE, message = FALSE, echo = FALSE)
library(dplyr)
library(glue)
library(ggplot2)
library(knitr)
library(gt)
library(ggtext)
library(scales)
df_all = params$df_all
if (is.null(df_all)) {df_all <- readRDS("../sprtt_plan_sample_size/meta_data/sprt_tool_df_all_10000.rds")}
pick_f_expected = params$f_expected
pick_power = 1 - params$beta
pick_beta = params$beta
pick_k_groups = params$k_groups
pick_decision_rate = params$decision_rate
data_version <- params$data_version
data_created <- params$data_created
pick_decision_rate_var = case_when(
pick_decision_rate == 0.75 ~ "q75_n",
pick_decision_rate == 0.80 ~ "q80_n",
pick_decision_rate == 0.85 ~ "q85_n",
pick_decision_rate == 0.90 ~ "q90_n",
pick_decision_rate == 0.95 ~ "q95_n"
)
n_rep = df_all %>% filter(f_simulated == 0,
f_expected == pick_f_expected,
k_groups == pick_k_groups,
power == pick_power) %>% nrow(.)
htmltools::tags$script(htmltools::HTML(sprintf("
document.addEventListener('DOMContentLoaded', function() {
setTimeout(function() {
var tocify = document.querySelector('.tocify');
if (tocify) {
var header = document.createElement('div');
header.style.padding = '20px';
header.style.backgroundColor = '#2c3e50';
header.innerHTML = '<p style=\"font-size: 1.5em; color: white; font-weight: bold; margin: 0;\"><i>f</i><sub>exp</sub> = %s</p>';
tocify.insertBefore(header, tocify.firstChild);
}
}, 100);
});
", pick_f_expected)))
# data -------------------------------------------------------------------------
#load(glue("{params$data_path}/sprt_tool_samples_{n_rep}.RData"))
# load(glue("meta_data/sprt_tool_samples_{n_rep}.RData"))
# df <- sprtt:::df
# df_all <- load_sample_size_data()
# df_all <- getFromNamespace("df_all", "sprtt")
# df <- getFromNamespace("df", "sprtt")
# variables --------------------------------------------------------------------
digits <- 2
palette <- "RdYlBu" #"Dark2"
light_green <- "#a5d1c7"
green <- "#69b3a2"
dark_green <- "#548f81"
dark2_green <- "#104949"
light_blue <- "#cce5ff"
grey_blue <- "#bccfe5"
blue <- "#2c7bb6" #"#404080"
dark_blue <- "#1b3c70"
magenta <- "#e61be5"
rosa <- "#ff0088"
hell_rosa <- "#ffa1c2"
light_red <- "#e72b2e"
red <- "#d7191c"
# red <- "#d7191c" #"#ca0020" "#CD2626" "#8B0000"
dark_red <- "#8b1012"
black_red <- "#4b1919" # "#651718"
light_orange <- "#fffcf9"
orange <- "#fdae61"
dark_orange <- "#fc8715"
yellow <- "#ffffbf"
# Define Flatly-compatible accent colors (muted, modern)
light_green <- "#18BC9C" # Flatly teal
flatly_yellow <- "#F1C40F" # gold
light_red <- "#E74C3C" # Flatly red
flatly_red_dark <- "#C0392B" # darker red
flatly_blue <- "#387ba8" # Accent for lines
flatly_dark <- "#2c3e50" # blue of the theme
flatly_purple <- "#A569BD" # amethyst
flatly_gray_light <- "#ECF0F1" # very light gray (bg)
flatly_gray_dark <- "#7F8C8D" # dark gray
flatly_border <- "#BDC3C7" # subtle borders
fixed_color <- light_red
dpi = 150
base_size <- 30
linewidth = 1.5
theme_set(theme_bw(base_size = base_size))
# sprtt_cit <- paste(format(citation("sprtt"), style = "text"), collapse = " ")
# sprtt_cit <- gsub("_(.+?)_", "<em>\\1</em>", sprtt_cit, perl = TRUE)
#
# # Match the last angle-bracket URL by greedily capturing the prefix
# sprtt_cit <- sub("(?s)^(.*)<\\s*(https?://[^&\\s]+)\\s*>(.*)$",
# '\\1<br><a href="\\2" target="_blank" rel="noopener">\\2</a>\\3',
# sprtt_cit, perl = TRUE)
# sprtt_cit <- sub("(?s)^(.*)<\\s*(https?://[^>\\s]+)\\s*>(.*)$",
# '\\1<br><a href="\\2" target="_blank" rel="noopener">\\2</a>\\3',
# sprtt_cit, perl = TRUE)
#
# cat(sprintf(
# '<p class="author-line"><i>created by the</i> [sprtt](https://meikesteinhilber.github.io/sprtt/) <i>package</i><br>
# <cite style="font-size:0.85em;color:#555;line-height:1.4;overflow-wrap:anywhere;">%s</cite></p>',
# sprtt_cit
# ))
#
sprtt_cit <- paste(format(citation("sprtt"), style = "text"), collapse = " ")
sprtt_cit <- gsub("_(.+?)_", "<em>\\1</em>", sprtt_cit, perl = TRUE)
# Remove URLs in angle brackets (both escaped & literal), plus a trailing dot if present
sprtt_cit <- gsub("<\\s*https?://[^&\\s>]+\\s*>\\.?","", sprtt_cit, perl=TRUE)
sprtt_cit <- gsub("<\\s*https?://[^>\\s]+\\s*>\\.?","", sprtt_cit, perl=TRUE)
# (Optional) also remove bare URLs that might appear without <...>
sprtt_cit <- gsub("\\bhttps?://[^\\s<>]+\\b\\.?","", sprtt_cit, perl=TRUE)
# Clean up leftover spaces/punctuation
sprtt_cit <- gsub("\\s+,", ",", sprtt_cit)
sprtt_cit <- gsub("\\s+\\.", ".", sprtt_cit)
sprtt_cit <- gsub("\\s{2,}", " ", sprtt_cit)
sprtt_cit <- trimws(sprtt_cit)
# cat(sprintf(
# '<p class="author-line"><i>created by the</i> <a href="https://meikesteinhilber.github.io/sprtt/" target="_blank" rel="noopener">sprtt</a> <i>package</i><br>
# <cite style="font-size:0.85em;color:#555;line-height:1.4;">%s</cite></p>',
# sprtt_cit
# ))
cat(sprintf(
'<p class="author-line"><i>created by the</i> <a href="https://meikesteinhilber.github.io/sprtt/" target="_blank" rel="noopener">sprtt</a> <i>package</i><br>
<cite style="font-size:0.85em;color:#555;line-height:1.4;">%s</cite><br>
<span style="font-size:0.85em;color:#555;margin-top:8px;display:inline-block;">Source code of the simulation: <a href="https://github.com/MeikeSteinhilber/sprtt_plan_sample_size" target="_blank" rel="noopener"><img src="https://img.shields.io/badge/GitHub-MeikeSteinhilber/sprtt__plan__sample__size-blue?logo=github" alt="GitHub" style="vertical-align:middle;"></a></span></p>',
sprtt_cit
))
Overview
This report provides practical guidance for planning studies using sequential ANOVA (SPRT), where the final sample size is not fixed in advance.
Unlike traditional sample size analyses, this report cannot predict the exact sample size needed to reach a decision in a specific study.
Instead, it offers evidence-based recommendations derived from simulations, showing what sample sizes are typically required under various scenarios.
Thus, these benchmarks enable realistic resource planning.
::: {.alert .alert-warning}
The actual final sample size in any study may differ substantially from the following recommendations due to sampling variability and departures from the assumed effect structure.
:::
Abbreviations
| Parameter | Description |
|:---|:-------------|
| $f_{\text{exp}}$ | Expected effect size (target effect) used for planning the sequential design |
| $f_{\text{true}}$ | True effect size in the simulated population |
| $\alpha$ | Type I error rate (probability of false positive) |
| $\beta$ | Type II error rate (probability of false negative) |
| $1-\beta$ | Target power, when no maximum sample size is used. The desired probability of detecting a true effect. |
| $k$ | Number of groups |
| $N$ | Sample size |
| $N_{\text{max}}$ | The maximum sample size when the researcher stops collecting data independent of the test decision. This sample size is only reached in the worst-case scenario. |
| $N_{\text{median}}$ | The median sample size at which a decision is reached across simulations: 50% of simulated studies required fewer observations and 50% required more.|
Content
Chapter I illustrates the consequences of choosing a target effect size $f_{\text{exp}}$ across a range of possible true effects $f_{\text{true}}$. Although not specific to sequential designs, this perspective is essential for selecting a sensible expected effect size.
Chapter II presents the core planning results for a sequential study, focusing on two benchmark cases: the true effect equals the specified value ($f_{\text{true}} = f_{\text{exp}}$) and there is no true effect ($f_{\text{true}} = 0$).
Chapter III offers extended plots and tables to explore additional scenarios with more varied $f_{\text{true}}$ values.
Technical details
The following results are based on a simulation with r n_rep iterations per condition.
Data were generated from a normal distribution, $\mathcal{N}(\mu,\sigma^2)$, under equal variances across groups and strictly balanced group sizes throughout data collection.
The analyses below use the following specifications:
-
$f_{exp}$ = r pick_f_expected
-
k groups = r pick_k_groups
-
$\alpha$ = 0.05
-
$\beta$ = r pick_beta
-
decision rate = r pick_decision_rate*100%
-
Simulation dataset: version r data_version (released: r data_created, view on GitHub)
I. Influence of $f_{\text{exp}}$ {#chapter-1}
For this report, the effect size was specified as $f_{\text{exp}} = r pick_f_expected$.
Choosing $f_{\text{exp}}$ is critical because it determines:
-
which effect sizes can be detected with the target power and
-
how much data are typically required to reach a decision.
The plot below shows the power curve across possible true effects in the population, $f_{\text{true}}$.
The red color indicates that the power to detect a true effect of the corresponding size falls below the target power of r pick_power, suggesting the design is underpowered for such effect sizes.
The green color indicates that the power meets or exceeds the target power.
This plot serves an educational purpose: it illustrates why you should choose an effect size that reflects your actual research interest.
If detecting that effect requires resources beyond what's feasible, it's worth pausing to consider alternatives.
plot_cases <- df_all %>%
mutate(fill_group = factor(as.integer(f_simulated))) %>%
filter(f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups
) %>%
filter(f_simulated != 0) %>%
group_by(
f_simulated,
f_expected,
k_groups,
alpha,
power,
distribution,
sd,
sample_ratio) %>%
mutate(
decision_status_50 = if_else(decision != "continue sampling" & n <= q50_n, 1, 0),
decision_status_75 = if_else(decision != "continue sampling" & n <= q75_n, 1, 0),
decision_status_90 = if_else(decision != "continue sampling" & n <= q90_n, 1, 0),
decision_status_95 = if_else(decision != "continue sampling" & n <= q95_n, 1, 0),
decision_status_100 = if_else(decision != "continue sampling", 1, 0)
) %>%
summarize(
error_rate = mean(decision_error),
mean_n = mean(n),
median_n = median(n),
q90_n = quantile(n, 0.90),
) %>% mutate(
simulated_power = if_else(f_simulated != 0, 1 - error_rate, NA),
.after = power
)
# 1) Build a dense x-grid and linearly interpolate simulated_power
rng <- range(plot_cases$f_simulated)
grid <- tibble(f_simulated = seq(rng[1], rng[2], length.out = 1000))
grid$simulated_power <- with(plot_cases,
approx(x = f_simulated, y = simulated_power, xout = grid$f_simulated,
method = "linear", rule = 2)$y
)
# 2) Compute above/below and y-bounds for one ribbon layer
shade <- grid %>%
mutate(
above = simulated_power >= pick_power,
ymin = pmin(simulated_power, pick_power),
ymax = pmax(simulated_power, pick_power)
)
# 3) Plot: one ribbon (colored by above/below), then your original line/points
ggplot() +
geom_ribbon(
data = shade,
aes(x = f_simulated, ymin = ymin, ymax = ymax, fill = above),
alpha = 0.25, colour = NA
) +
scale_fill_manual(values = c(`TRUE` = light_green, `FALSE` = light_red), guide = "none") +
geom_line(data = plot_cases, aes(f_simulated, simulated_power),
linewidth = 1.2, colour = flatly_dark) +
geom_point(data = plot_cases, aes(f_simulated, simulated_power),
size = 3.8, colour = flatly_blue, fill = flatly_blue,
shape = 21, stroke = 1.2) +
geom_hline(yintercept = pick_power, linetype = "dashed", colour = flatly_dark) +
geom_segment(aes(x = pick_f_expected, xend = pick_f_expected,
y = 0, yend = 1), # Adjust yend to control where line stops
linetype = "dashed", colour = flatly_dark) +
annotate(
"text",
x = pick_f_expected,
y = 1, # Position text just above the line
label = expression(italic(f)[exp]),
hjust = 0.5, # Center horizontally
vjust = 0, # Bottom of text at y position
size = base_size * 0.25,
colour = flatly_dark
) +
scale_y_continuous(limits = c(0, 1.1), breaks = seq(0, 1, by = 0.25),
labels = scales::percent_format(accuracy = 1)) +
scale_x_continuous(expand = expansion(mult = c(0.02, 0.02)),
breaks = unique(plot_cases$f_simulated)) +
labs(
title = "Simulated power across true effect sizes",
x = expression(italic(f)[true]),
y = "Simulated power",
subtitle = glue::glue(
"<i>f</i><sub>exp</sub> = {pick_f_expected}, ",
"α = 0.05, β = {pick_beta}, groups = {pick_k_groups}"
)
) +
theme_minimal(base_size = base_size) +
theme(
text = element_text(colour = flatly_dark), # <-- sets ALL text to blue
plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark),
plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"),
axis.title = element_text(face = "bold"),
axis.text = element_text(colour = "grey20"),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
legend.position = "none",
plot.title.position = "plot"
) -> plot
if (pick_f_expected == 0.10){
plot + annotate(
"text",
x = min(plot_cases$f_simulated),
y = pick_power,
label = paste0(" target power = ", percent(pick_power)),
hjust = 0,
vjust = 2,
size = base_size * 0.25,
colour = flatly_dark
)
} else if (pick_f_expected == 0.15) {
plot + annotate(
"text",
x = max(plot_cases$f_simulated) - 0.07,
y = pick_power,
label = paste0(" target power = ", percent(pick_power)),
hjust = 0,
vjust = 2,
size = base_size * 0.25,
colour = flatly_dark
)
} else{
plot + annotate(
"text",
x = min(plot_cases$f_simulated),
y = pick_power + 0.1,
label = paste0(" target power = ", percent(pick_power)),
hjust = 0,
vjust = 2,
size = base_size * 0.25,
colour = flatly_dark
)
}
::: {.alert .alert-info}
It is recommended to set $f_{\text{exp}}$ to the minimum effect of interest: power declines quickly for effects smaller than $f_{\text{exp}}$, whereas choosing a much larger $f_{\text{exp}}$ may shorten data collection but risks missing practically relevant effects just below that value.
:::
II. Sample size recommendations {#chapter-2}
# pick_f_simulated <- c(0, pick_f_expected)
pick_f_simulated = c(0,
pick_f_expected - 0.05,
pick_f_expected,
pick_f_expected + 0.05)
table_cases <- df_all %>%
mutate(
f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))),
fill_group = factor(as.integer(f_simulated))
) %>%
filter(
f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups,
f_simulated %in% pick_f_simulated
) %>%
mutate(grand_median_n = as.integer(median(n))) %>%
group_by(
f_simulated,
f_expected,
k_groups,
alpha,
power,
distribution,
sd,
sample_ratio
) %>%
mutate(
decision_status_50 = if_else(decision != "continue sampling" & n <= quantile(n, 0.50), 1, 0),
decision_status_75 = if_else(decision != "continue sampling" & n <= quantile(n, 0.75), 1, 0),
decision_status_90 = if_else(decision != "continue sampling" & n <= quantile(n, 0.90), 1, 0),
decision_status_95 = if_else(decision != "continue sampling" & n <= quantile(n, 0.95), 1, 0),
decision_status_100 = if_else(decision != "continue sampling", 1, 0)
) %>%
group_by(f_simulated, f_expected, power) %>%
summarize(
decision_error_rate = mean(decision_error),
fix_n = as.integer(mean(fix_n)),
mean_n = as.integer(round(mean(n))),
median_n = as.integer(median(n)),
grand_median_n = grand_median_n[1],
min_n = as.integer(min(n)),
max_n = max(n),
decision_rate_100 = sum(decision_status_100) / n(),
q25_n = as.integer(round(quantile(n, 0.25))),
q50_n = as.integer(round(quantile(n, 0.50))),
q75_n = as.integer(round(quantile(n, 0.75))),
q80_n = as.integer(round(quantile(n, 0.80))),
q85_n = as.integer(round(quantile(n, 0.85))),
q90_n = as.integer(round(quantile(n, 0.90))),
q95_n = as.integer(round(quantile(n, 0.95))),
decision_rate_50 = sum(decision_status_50) / n(),
decision_rate_75 = sum(decision_status_75) / n(),
decision_rate_90 = sum(decision_status_90) / n(),
decision_rate_95 = sum(decision_status_95) / n(),
.groups = "drop"
) %>%
mutate(decision_error_rate = round(decision_error_rate*100,1)) %>%
select(-power) %>%
ungroup()
recommendation <- table_cases %>%
filter(f_simulated %in% c(0, pick_f_expected)) %>%
slice_max(order_by = .data[[pick_decision_rate_var]], n = 1, with_ties = FALSE)
n_mean <- round(mean(table_cases$mean_n), 0)
n_median_grand <- table_cases$grand_median_n[1]
n_max <- recommendation %>% pull(.data[[pick_decision_rate_var]])
simulated_power_data <- df_all %>%
mutate(
f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated)))
) %>%
filter(
f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups,
f_simulated %in% pick_f_simulated
) %>%
group_by(f_simulated, f_expected, power) %>%
summarize(
decision_error_rate_nmax = mean(if_else(decision_error == 1 & n <= n_max, 1, 0)),
sd_error_n = sd(n) / sqrt(length(n)),
simulated_power_nmax = mean(if_else(f_simulated != "0" & decision == "accept H1" & n <= n_max, 1, 0)),
.groups = "drop"
) %>%
mutate(decision_error_rate_nmax = round(decision_error_rate_nmax*100,1)) %>%
mutate(simulated_power_nmax = if_else(simulated_power_nmax == 0, "-", as.character(round(simulated_power_nmax*100,1)))) %>%
select(-power)
table_cases <- table_cases %>%
left_join(simulated_power_data, by = c("f_simulated", "f_expected")) %>%
select(
f_simulated,
decision_error_rate,
decision_error_rate_nmax,
simulated_power_nmax,
mean_n,
median_n,
grand_median_n,
min_n,
max_n,
q75_n,
q80_n,
q85_n,
q90_n,
q95_n,
fix_n
)
power_nmax <- table_cases$simulated_power_nmax[table_cases$f_simulated == pick_f_expected]
In the following plot you can see a visualization of the simulated samples, where the effect in the data is either as expected or zero. For a extended version of these results see Chapter III.
This plot visualizes the distribution of sample sizes required to reach a decision in sequential and fixed testing, comparing two scenarios: when the true effect matches your expectation ($f_{\text{true}} =$ r pick_f_expected) versus when there's no effect ($f_{\text{true}} =$ 0).
The violin plots reveal substantial variability, while many sequential studies terminate early (note the low median sample size), some require substantially more data.
The red diamonds show the fixed sample size from traditional a priori power analysis as a point or reference.
In most cases, the final sample size will be close to $N_{\text{median}}$, however for the worst case one should have the resources for $N_{\text{max}}$ to have a r pick_decision_rate*100% chance to reach a decision.
pick_f_simulated <- c(0, pick_f_expected)
# titles
title_html <- glue("<i>f</i><sub>exp</sub> = {pick_f_expected}")
caption_html <- glue(
# "<i>f</i><sub>true</sub> = {pick_f_expected},<br>",
"β = {pick_beta}, α = 0.05, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}"
)
df_all %>%
mutate(f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))),
fill_group = factor(as.integer(f_simulated))) %>%
filter(f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups
) %>%
filter(f_simulated %in% pick_f_simulated) %>%
{. ->> cases} %>%
ggplot(aes(x = f_simulated, y = n)) +
geom_violin(trim = FALSE, fill = light_green,
scale = "count",
linewidth = 0.3,
alpha = 0.25) +
coord_cartesian(ylim = c(0, cases$fix_n[1] * 2.5)) +
geom_hline(yintercept = n_median_grand, linetype = "dashed", color = flatly_dark, linewidth = 0.8) +
geom_hline(yintercept = n_max, linetype = "dashed", color = flatly_dark, linewidth = 0.8) +
annotate("text", x = 2.45, y = n_median_grand + 5,
label = "bar(italic(N))[median]", parse = TRUE, vjust = -0.1,
size = base_size * 0.25, color = flatly_dark) +
annotate("text", x = 2.45, y = n_max + 5,
label = "italic(N)[max]", parse = TRUE, vjust = -0.1,
size = base_size * 0.25, color = flatly_dark) +
geom_point(aes(x = f_simulated, y = fix_n, color = "Fixed sample size"),
position = position_dodge(0.9),
shape = 18,
size = 11) +
geom_point(aes(x = f_simulated, y = median_n, color = "Median sample size"),
position = position_dodge(0.9),
shape = 15,
size = 8) +
labs(
x = "<i>f</i><sub>true</sub>",
y = "<i>N</i>",
title = "Required sample sizes to reach a decision",
subtitle = glue::glue(
"<i>f</i><sub>exp</sub> = {pick_f_expected}, ",
"α = 0.05, β = {pick_beta}, groups = {pick_k_groups}"
)) +
scale_color_manual(
name = "Legend",
values = c("Fixed sample size" = fixed_color,
"Median sample size" = flatly_dark),
labels = c("Fixed sample size" = "a priori power analysis",
"Median sample size" = "median sample size")
) +
guides(
color = guide_legend(override.aes = list(size = 5))
) +
theme_minimal(base_size = base_size) +
theme(text = element_text(colour = flatly_dark),
plot.title = element_text(face = "bold", size = base_size,
hjust = 0, colour = flatly_dark),
plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"),
plot.caption = element_markdown(),
axis.title.x = element_markdown(),
axis.title.y = element_markdown(angle = 180, vjust = 0.5),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
legend.position = "right",
legend.text = element_text(size = base_size * 0.7)
) -> p_violin
p_violin
::: {.alert .alert-info}
In short, to achieve a decision rate of r pick_decision_rate*100%,
plan for a maximum sample size of $N_{\text{max}} = r n_max$.
While you must plan for this worst-case maximum,
the median sample size is only $\bar{N}{\text{median}} =$ r n_median_grand, meaning half of the time studies will terminate before reaching $N{\text{median}}$.
Using $N_{\text{max}} = r n_max$ will yield a power of $\text{Power}{N{\text{max}}}=$ r power_nmax%, accounting for both Type II errors and non-decisions.
:::
Extended numeric details are shown in the table below.
Here you can also see the influence of the required sample sizes for different decision rates.
table_cases %>%
filter(f_simulated %in% pick_f_simulated) %>%
select(-grand_median_n, -simulated_power_nmax, -decision_error_rate_nmax) %>%
ungroup() %>%
gt() %>%
tab_header(
title = gt::html("<i>Summary table</i>"),
subtitle = gt::html(glue("<i>f</i><sub>exp</sub> = {pick_f_expected}, α = 0.05, β = {pick_beta}, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}"))
) %>%
# center all data columns
cols_align(align = "center", columns = everything()) %>%
# center column labels and the heading
tab_options(
heading.align = "left"
) %>%
cols_label(
f_simulated = gt::html("<i>f</i><sub>true</sub>"),
# f_expected = gt::html("<i>f</i><sub>exp</sub>"),
decision_error_rate = "Error rate %",
# decision_error_rate_nmax = gt::html("Error rate<sub>N<sub>max</sub></sub>%"),
# simulated_power_nmax = gt::html("Power<sub>N<sub>max</sub></sub>%"),
fix_n = html("Reference <i>N</i>:<br>fixed design"),
mean_n = "Mean",
median_n = "Median",
min_n = "Min",
max_n = "Max",
# decision_rate_90 = "90% decision rate",
q75_n = "75%",
q80_n = "80%",
q85_n = "85%",
q90_n = "90%",
q95_n = "95%"
# decision_rate_95 = "95% decision rate"
) %>%
# high-level headers (spanners)
tab_spanner(
label = "Sample size (N)",
columns = c(mean_n, median_n, min_n, max_n)
) %>%
tab_spanner(
label = html("<i>N</i> to reach decision rate (%)"),
columns = c(q75_n, q80_n, q85_n, q90_n, q95_n)
) %>%
# tab_spanner(
# label = html("Reference fixed design N"),
# columns = c(fix_n)
# ) %>%
data_color(
columns = median_n,
palette = grey_blue
) %>%
data_color(
columns = !!pick_decision_rate_var,
palette = grey_blue
) %>%
data_color(
columns = fix_n,
palette = "darkgrey"
) %>%
fmt_number(
columns = where(is.double),
decimals = 2
) %>%
tab_footnote(
footnote = html(glue("simulated error rates when sampling continous until a decision is reached")),
locations = cells_column_labels(columns = decision_error_rate)
) %>%
# tab_footnote(
# footnote = html(glue("simulated error rates with <i>N</i><sub>max</sub> = {n_max}")),
# locations = cells_column_labels(columns = decision_error_rate_nmax)
# ) %>%
# tab_footnote(
# footnote = html(glue("simulated power to detect an effect with <i>N</i><sub>max</sub> = {n_max}")),
# locations = cells_column_labels(columns = simulated_power_nmax)
# ) %>%
tab_footnote(
footnote = html(glue("grand median: <i>N̅</i><sub>median</sub> = {n_median_grand}")),
locations = cells_column_labels(columns = median_n)
) %>%
tab_footnote(
footnote = html(glue("recommended <i>N</i><sub>max</sub> = {n_max}")),
locations = cells_column_labels(columns = !!pick_decision_rate_var)
)
For SPRTs, the power is $1-\beta$ when no maximum sample size is imposed, which is the theoretical setup for an SPRT.
However, for practical resource planning, we introduce $N_{\text{max}}$, which decreases the achievable power.
Therefore, we define $\text{Power}{N{\text{max}}}$ as the power calculated from simulated data, accounting for both Type II errors and non-decisions.
We generally recommend maintaining a low $\beta$ and accepting a lower decision rate to manage resource constraints, rather than relaxing the Type II error rate.
Low error rates combined with a lower decision rate ensure that when the procedure reaches a decision, the result is trustworthy due to strict long-run error control.
Importantly, non-decisions preserve flexibility: as long as no decision has been reached, data collection can continue if additional resources become available.
III. Extended insights {#chapter-3}
Plot: Sample size and varing $f_{\text{true}}$ {#plot .toc-only}
pick_f_simulated = c(0,
pick_f_expected - 0.05,
pick_f_expected,
pick_f_expected + 0.05)
This violin plot shows the distribution of required sample sizes $n$ across simulations for different assumed true effects $f_{\text{true}}$.
The violin colors indicate whether the test controls the error rates reliably at a given setting.
-
Green marks settings where $f_{\text{true}} \geq f_{\text{exp}}$ (or $f_{\text{true}} = 0$), at which the test reliably controls the error rates.
-
Red marks settings where the $f_{\text{true}} < f_{\text{exp}}$ (and $f_{\text{true}} \neq 0$), at which the test no longer reliably controls the error rates and such effects would often go undetected. This is analogous to an underpowered fixed design: the test was not designed for effects this small, and it is not clear what the correct decision would be in such cases. (If f_expected = 0.1 is selected, no red violin is shown in the plot below as it is outside of the simulated scope.)
The red diamond marks the fixed sample size from an a priori power analysis, and the blue square shows the mean sample size observed across simulations.
# violin_colors <- c(light_blue, hell_rosa, light_blue, light_blue)
# title_html <- glue("<i>f</i><sub>exp</sub> = {pick_f_expected}")
caption_html <- glue(
"β = {pick_beta}, α = 0.05,<br>",
"groups = {pick_k_groups}"
)
p_violin <- df_all %>%
mutate(
f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))),
fill_label = ifelse(f_simulated == pick_f_expected - 0.05,
"error rates not controlled",
"error rates controlled")
) %>%
filter(
f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups
) %>%
filter(f_simulated %in% pick_f_simulated) %>%
ggplot(aes(x = as.factor(f_simulated), y = n, fill = fill_label)) +
# violins (fill legend only)
geom_violin(
trim = FALSE,
scale = "count",
# draw_quantiles = c(0.25, 0.50, 0.75),
# linewidth = 0.1,
color = "lightgrey",
alpha = 0.25
) +
scale_fill_manual(
name = "Power",
values = c("error rates controlled" = light_green,
"error rates not controlled" = light_red)
) +
# red diamond = fixed sample size
geom_point(
aes(y = fix_n, color = "Fixed sample size"),
position = position_dodge(0.9),
shape = 18, # diamond, no border
size = 7,
stroke = 0 # ensures no black outline
) +
# blue square = mean sample size
geom_point(
aes(y = median_n, color = "Median sample size"),
position = position_dodge(0.9),
shape = 15, # square, no border
size = 6,
stroke = 0 # ensures no black outline
) +
scale_color_manual(
name = "Legend",
values = c("Fixed sample size" = fixed_color,
"Median sample size" = flatly_dark),
labels = c("Fixed sample size" = "a priori power analysis",
"Median sample size" = "median sample size")
) +
labs(
x = "<i>f</i><sub>true</sub>",
y = "<i>N</i>",
title = "Required sample sizes to reach a decision",
subtitle = glue::glue(
"<i>f</i><sub>exp</sub> = {pick_f_expected}, ",
"α = 0.05, β = {pick_beta}, groups = {pick_k_groups}"
)
) +
# clean legend appearance
guides(
fill = guide_legend(override.aes = list(shape = NA)), # patches only
color = guide_legend(override.aes = list(stroke = 0, size = 5)) # points only
) +
theme_minimal(base_size = base_size) +
theme(
text = element_text(colour = flatly_dark),
legend.key = element_blank(), # no background box around keys
legend.text = element_text(size = base_size * 0.7),
# plot.title = element_markdown(),
# plot.subtitle = element_markdown(),
plot.caption = element_markdown(),
axis.title.x = element_markdown(),
axis.title.y = element_markdown(angle = 180, vjust = 0.5),
# panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank(),
plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark),
plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40")
)
p_violin
Extended numeric details are shown in the table below.
Here you can also see the influence of the required sample sizes for different decision rates.
num_cols <- c("f_simulated", "decision_error_rate")
table_cases %>%
select(-grand_median_n, -simulated_power_nmax, -decision_error_rate_nmax) %>%
ungroup() %>%
gt() %>%
tab_header(
title = gt::html("<i>Summary table</i>"),
subtitle = gt::html(glue("<i>f</i><sub>exp</sub> = {pick_f_expected}, α = 0.05, β = {pick_beta}, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}"))
) %>%
cols_align(align = "center", columns = everything()) %>%
tab_options(
heading.align = "left"
) %>%
cols_label(
f_simulated = gt::html("<i>f</i><sub>true</sub>"),
decision_error_rate = "Error rate %",
fix_n = html("Reference <i>N</i>:<br>fixed design"),
mean_n = "Mean",
median_n = "Median",
min_n = "Min",
max_n = "Max",
q75_n = "75%",
q80_n = "80%",
q85_n = "85%",
q90_n = "90%",
q95_n = "95%"
) %>%
tab_spanner(
label = "Sample size (N)",
columns = c(mean_n, median_n, min_n, max_n)
) %>%
tab_spanner(
label = html("<i>N</i> to reach decision rate (%)"),
columns = c(q75_n, q80_n, q85_n, q90_n, q95_n)
) %>%
data_color(
columns = all_of(num_cols),
rows = as.numeric(as.character(f_simulated)) < pick_f_expected &
as.numeric(as.character(f_simulated)) != 0,
colors = light_red,
alpha = 0.25,
autocolor_text = FALSE
) %>%
data_color(
columns = median_n,
palette = grey_blue
) %>%
data_color(
columns = !!pick_decision_rate_var,
palette = grey_blue
) %>%
data_color(
columns = fix_n,
palette = "darkgrey"
) %>%
fmt_number(
columns = where(is.double),
decimals = 2
) %>%
tab_footnote(
footnote = html(glue("simulated error rates when sampling continuous until a decision is reached")),
locations = cells_column_labels(columns = decision_error_rate)
)
Plot: Sample size and varing $f_{\text{exp}}$ {#sample-size-diff .toc-only}
The next plot below visualizes the required sample sizes, when the true value is set and one uses different specification of $f_{\text{exp}}$.
Here you can see how the specification of $f_{\text{exp}}$ influences the sample sizes also in direct comparison to a fixed sample plan.
Sequential designs maintain efficiency despite underestimating $f_{\text{true}}$, whereas fixed designs are locked into their initial specification -- a key advantage demonstrated in this plot
pick_f_simulated = pick_f_expected
# titles
title_html <- glue("<i>f</i><sub>true</sub> = {pick_f_simulated}")
subtitle_html <- glue(
# "<i>f</i><sub>true</sub> = {pick_f_expected},<br>",
"β = {pick_beta}, α = 0.05,<br> groups = {pick_k_groups}"
)
df_all %>%
mutate(f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))),
fill_group = factor(as.integer(f_simulated))
) %>%
filter(f_simulated == pick_f_simulated,
f_expected <= pick_f_simulated,
power == pick_power,
k_groups == pick_k_groups
) %>%
mutate(violin_color = if_else(f_expected < pick_f_expected &
f_expected != 0,
light_green, light_green),
f_expected = factor(f_expected)) %>%
group_by(f_expected) %>%
{. ->> cases} %>%
ggplot(aes(x = f_expected, y = n)) +
geom_violin(aes(fill = violin_color), trim = FALSE,
scale = "count",
linewidth = 0.3,
alpha = 0.25) +
scale_fill_identity() +
geom_point(aes(x = f_expected, y = fix_n, color = "Fixed sample size"),
position = position_dodge(0.9),
shape = 18,
size = 9) +
geom_point(aes(x = f_expected, y = median_n, color = "Median sample size"),
position = position_dodge(0.9),
shape = 15,
size = 6) +
labs(
x = "<i>f</i><sub>exp</sub>",
y = "<i>N</i>",
title = "Required sample sizes to reach a decision",
subtitle = glue::glue(
"<i>f</i><sub>true</sub> = {pick_f_simulated}, ",
"α = 0.05, β = {pick_beta}, groups = {pick_k_groups}"
)) +
scale_color_manual(
name = "Legend",
values = c("Fixed sample size" = fixed_color,
"Median sample size" = flatly_dark),
labels = c("Fixed sample size" = "a priori power analysis",
"Median sample size" = "median sample size")
) +
guides(
color = guide_legend(override.aes = list(size = 5))
) +
theme_minimal(base_size = base_size) +
theme(text = element_text(colour = flatly_dark),
plot.title = element_text(face = "bold", size = base_size, hjust = 0,
colour = flatly_dark),
plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"),
plot.caption = element_markdown(),
axis.title.x = element_markdown(),
axis.title.y = element_markdown(angle = 180, vjust = 0.5),
panel.grid.minor.y = element_blank(),
panel.grid.major.x = element_blank(),
legend.position = "right",
legend.text = element_text(size = base_size * 0.7)
) -> p_violin
p_violin
Plot: Cumulative decisions {#extended-cumulative .toc-only}
This plot illustrates how decision rate accumulates with increasing sample size for different true effects.
Larger effects reach the 90% decision threshold much earlier, while smaller effects require substantially more data.
The vertical line marks the fixed sample size.
Notice how efficiency varies depending on whether the true effect is larger, equal to, or smaller than your expected effect.
df_cum <- df_all %>%
filter(f_expected == pick_f_expected,
power == pick_power,
k_groups == pick_k_groups) %>%
filter(decision != "continue sampling") %>%
transmute(f_simulated, fix_n, n_decision = n) %>%
group_by(f_simulated) %>%
arrange(n_decision, .by_group = TRUE) %>%
mutate(cum_prop = row_number() / n()) %>%
ungroup() %>%
mutate(
is_expected = f_simulated == pick_f_expected,
f_label = ifelse(is_expected,
paste0(f_simulated, " (=expected)"),
as.character(f_simulated))
)
# Find the minimum n that achieves at least 90% decided
cut90 <- df_cum %>%
group_by(f_simulated) %>%
summarise(n_at_90 = min(n_decision[cum_prop >= 0.90]), .groups = "drop")
# Get Set2 palette colors
set2_colors <- RColorBrewer::brewer.pal(n = length(unique(df_cum$f_label)), name = "Set2")
# Create named vector with flatly_dark for expected line
color_values <- setNames(set2_colors, sort(unique(df_cum$f_label)))
expected_label <- paste0(pick_f_expected, " (= expected)")
color_values[expected_label] <- flatly_dark
# Plot with unified legend
ggplot(df_cum, aes(x = n_decision, y = cum_prop,
colour = f_label,
group = f_simulated,
linewidth = is_expected,
alpha = is_expected)) +
geom_step() +
scale_linewidth_manual(values = c("FALSE" = 0.9, "TRUE" = 1.8), guide = "none") +
scale_alpha_manual(values = c("FALSE" = 0.5, "TRUE" = 1.0), guide = "none") +
# geom_hline(yintercept = 0.90, linetype = "dotted", colour = flatly_dark) +
geom_vline(xintercept = unique(df_cum$fix_n), color = flatly_dark, linetype = "dashed") +
annotate(
"text",
x = unique(df_cum$fix_n) + (unique(df_cum$fix_n) * 0.07),
y = 0.05,
label = "fixed sample size",
angle = 90,
hjust = 0.25,
vjust = 1.3,
size = base_size * 0.25,
colour = flatly_dark
) +
scale_y_continuous(
limits = c(0, 1),
breaks = c(0, 0.25, 0.5, 0.75, 0.9, 1),
labels = percent_format(accuracy = 1)
) +
scale_color_manual(values = color_values,
name = expression(italic(f)[true])) +
labs(
x = "<i>N</i>",
y = "",
title = "Cumulative decision proportions across simulated\neffect sizes",
subtitle = glue::glue(
"<i>f</i><sub>exp</sub> = {pick_f_expected}, ",
"α = 0.05, β = {pick_beta}, groups = {pick_k_groups}"
)
) +
theme_minimal(base_size = base_size) +
theme(
plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark),
plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"),
panel.grid.minor = element_blank(),
panel.grid.major.x = element_blank(),
legend.title = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
plot.title.position = "plot",
axis.title.x = ggtext::element_markdown()
)
Try the sprtt package in your browser
Any scripts or data that you put into this service are public.
sprtt documentation built on May 6, 2026, 5:06 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
# DO NOT RUN # This code generates the html.file so the icon in the browser is the sprtt logo # Read and encode favicon favicon_base64 <- base64enc::base64encode("pkgdown/favicon/favicon.ico") # Create the HTML content html_content <- sprintf( '<link rel="shortcut icon" href="data:image/x-icon;base64,%s" type="image/x-icon" />', favicon_base64 ) # Write to file in the skeleton folder writeLines( html_content, "inst/rmarkdown/templates/report_sample_size/skeleton/favicon.html" )
knitr::opts_chunk$set(warning = FALSE, message = FALSE, echo = FALSE) library(dplyr) library(glue) library(ggplot2) library(knitr) library(gt) library(ggtext) library(scales)
df_all = params$df_all if (is.null(df_all)) {df_all <- readRDS("../sprtt_plan_sample_size/meta_data/sprt_tool_df_all_10000.rds")} pick_f_expected = params$f_expected pick_power = 1 - params$beta pick_beta = params$beta pick_k_groups = params$k_groups pick_decision_rate = params$decision_rate data_version <- params$data_version data_created <- params$data_created pick_decision_rate_var = case_when( pick_decision_rate == 0.75 ~ "q75_n", pick_decision_rate == 0.80 ~ "q80_n", pick_decision_rate == 0.85 ~ "q85_n", pick_decision_rate == 0.90 ~ "q90_n", pick_decision_rate == 0.95 ~ "q95_n" ) n_rep = df_all %>% filter(f_simulated == 0, f_expected == pick_f_expected, k_groups == pick_k_groups, power == pick_power) %>% nrow(.)
htmltools::tags$script(htmltools::HTML(sprintf(" document.addEventListener('DOMContentLoaded', function() { setTimeout(function() { var tocify = document.querySelector('.tocify'); if (tocify) { var header = document.createElement('div'); header.style.padding = '20px'; header.style.backgroundColor = '#2c3e50'; header.innerHTML = '<p style=\"font-size: 1.5em; color: white; font-weight: bold; margin: 0;\"><i>f</i><sub>exp</sub> = %s</p>'; tocify.insertBefore(header, tocify.firstChild); } }, 100); }); ", pick_f_expected)))
# data ------------------------------------------------------------------------- #load(glue("{params$data_path}/sprt_tool_samples_{n_rep}.RData")) # load(glue("meta_data/sprt_tool_samples_{n_rep}.RData")) # df <- sprtt:::df # df_all <- load_sample_size_data() # df_all <- getFromNamespace("df_all", "sprtt") # df <- getFromNamespace("df", "sprtt")
# variables -------------------------------------------------------------------- digits <- 2 palette <- "RdYlBu" #"Dark2" light_green <- "#a5d1c7" green <- "#69b3a2" dark_green <- "#548f81" dark2_green <- "#104949" light_blue <- "#cce5ff" grey_blue <- "#bccfe5" blue <- "#2c7bb6" #"#404080" dark_blue <- "#1b3c70" magenta <- "#e61be5" rosa <- "#ff0088" hell_rosa <- "#ffa1c2" light_red <- "#e72b2e" red <- "#d7191c" # red <- "#d7191c" #"#ca0020" "#CD2626" "#8B0000" dark_red <- "#8b1012" black_red <- "#4b1919" # "#651718" light_orange <- "#fffcf9" orange <- "#fdae61" dark_orange <- "#fc8715" yellow <- "#ffffbf" # Define Flatly-compatible accent colors (muted, modern) light_green <- "#18BC9C" # Flatly teal flatly_yellow <- "#F1C40F" # gold light_red <- "#E74C3C" # Flatly red flatly_red_dark <- "#C0392B" # darker red flatly_blue <- "#387ba8" # Accent for lines flatly_dark <- "#2c3e50" # blue of the theme flatly_purple <- "#A569BD" # amethyst flatly_gray_light <- "#ECF0F1" # very light gray (bg) flatly_gray_dark <- "#7F8C8D" # dark gray flatly_border <- "#BDC3C7" # subtle borders fixed_color <- light_red dpi = 150 base_size <- 30 linewidth = 1.5 theme_set(theme_bw(base_size = base_size))
# sprtt_cit <- paste(format(citation("sprtt"), style = "text"), collapse = " ") # sprtt_cit <- gsub("_(.+?)_", "<em>\\1</em>", sprtt_cit, perl = TRUE) # # # Match the last angle-bracket URL by greedily capturing the prefix # sprtt_cit <- sub("(?s)^(.*)<\\s*(https?://[^&\\s]+)\\s*>(.*)$", # '\\1<br><a href="\\2" target="_blank" rel="noopener">\\2</a>\\3', # sprtt_cit, perl = TRUE) # sprtt_cit <- sub("(?s)^(.*)<\\s*(https?://[^>\\s]+)\\s*>(.*)$", # '\\1<br><a href="\\2" target="_blank" rel="noopener">\\2</a>\\3', # sprtt_cit, perl = TRUE) # # cat(sprintf( # '<p class="author-line"><i>created by the</i> [sprtt](https://meikesteinhilber.github.io/sprtt/) <i>package</i><br> # <cite style="font-size:0.85em;color:#555;line-height:1.4;overflow-wrap:anywhere;">%s</cite></p>', # sprtt_cit # )) # sprtt_cit <- paste(format(citation("sprtt"), style = "text"), collapse = " ") sprtt_cit <- gsub("_(.+?)_", "<em>\\1</em>", sprtt_cit, perl = TRUE) # Remove URLs in angle brackets (both escaped & literal), plus a trailing dot if present sprtt_cit <- gsub("<\\s*https?://[^&\\s>]+\\s*>\\.?","", sprtt_cit, perl=TRUE) sprtt_cit <- gsub("<\\s*https?://[^>\\s]+\\s*>\\.?","", sprtt_cit, perl=TRUE) # (Optional) also remove bare URLs that might appear without <...> sprtt_cit <- gsub("\\bhttps?://[^\\s<>]+\\b\\.?","", sprtt_cit, perl=TRUE) # Clean up leftover spaces/punctuation sprtt_cit <- gsub("\\s+,", ",", sprtt_cit) sprtt_cit <- gsub("\\s+\\.", ".", sprtt_cit) sprtt_cit <- gsub("\\s{2,}", " ", sprtt_cit) sprtt_cit <- trimws(sprtt_cit) # cat(sprintf( # '<p class="author-line"><i>created by the</i> <a href="https://meikesteinhilber.github.io/sprtt/" target="_blank" rel="noopener">sprtt</a> <i>package</i><br> # <cite style="font-size:0.85em;color:#555;line-height:1.4;">%s</cite></p>', # sprtt_cit # )) cat(sprintf( '<p class="author-line"><i>created by the</i> <a href="https://meikesteinhilber.github.io/sprtt/" target="_blank" rel="noopener">sprtt</a> <i>package</i><br> <cite style="font-size:0.85em;color:#555;line-height:1.4;">%s</cite><br> <span style="font-size:0.85em;color:#555;margin-top:8px;display:inline-block;">Source code of the simulation: <a href="https://github.com/MeikeSteinhilber/sprtt_plan_sample_size" target="_blank" rel="noopener"><img src="https://img.shields.io/badge/GitHub-MeikeSteinhilber/sprtt__plan__sample__size-blue?logo=github" alt="GitHub" style="vertical-align:middle;"></a></span></p>', sprtt_cit ))
Overview
This report provides practical guidance for planning studies using sequential ANOVA (SPRT), where the final sample size is not fixed in advance.
Unlike traditional sample size analyses, this report cannot predict the exact sample size needed to reach a decision in a specific study. Instead, it offers evidence-based recommendations derived from simulations, showing what sample sizes are typically required under various scenarios. Thus, these benchmarks enable realistic resource planning.
::: {.alert .alert-warning} The actual final sample size in any study may differ substantially from the following recommendations due to sampling variability and departures from the assumed effect structure. :::
Abbreviations
| Parameter | Description | |:---|:-------------| | $f_{\text{exp}}$ | Expected effect size (target effect) used for planning the sequential design | | $f_{\text{true}}$ | True effect size in the simulated population | | $\alpha$ | Type I error rate (probability of false positive) | | $\beta$ | Type II error rate (probability of false negative) | | $1-\beta$ | Target power, when no maximum sample size is used. The desired probability of detecting a true effect. | | $k$ | Number of groups | | $N$ | Sample size | | $N_{\text{max}}$ | The maximum sample size when the researcher stops collecting data independent of the test decision. This sample size is only reached in the worst-case scenario. | | $N_{\text{median}}$ | The median sample size at which a decision is reached across simulations: 50% of simulated studies required fewer observations and 50% required more.|
Content
Chapter I illustrates the consequences of choosing a target effect size $f_{\text{exp}}$ across a range of possible true effects $f_{\text{true}}$. Although not specific to sequential designs, this perspective is essential for selecting a sensible expected effect size.
Chapter II presents the core planning results for a sequential study, focusing on two benchmark cases: the true effect equals the specified value ($f_{\text{true}} = f_{\text{exp}}$) and there is no true effect ($f_{\text{true}} = 0$).
Chapter III offers extended plots and tables to explore additional scenarios with more varied $f_{\text{true}}$ values.
Technical details
The following results are based on a simulation with r n_rep iterations per condition.
Data were generated from a normal distribution, $\mathcal{N}(\mu,\sigma^2)$, under equal variances across groups and strictly balanced group sizes throughout data collection.
The analyses below use the following specifications:
-
$f_{exp}$ =
r pick_f_expected -
k groups =
r pick_k_groups -
$\alpha$ = 0.05
-
$\beta$ =
r pick_beta -
decision rate =
r pick_decision_rate*100% -
Simulation dataset: version
r data_version(released:r data_created, view on GitHub)
I. Influence of $f_{\text{exp}}$ {#chapter-1}
For this report, the effect size was specified as $f_{\text{exp}} = r pick_f_expected$.
Choosing $f_{\text{exp}}$ is critical because it determines:
-
which effect sizes can be detected with the target power and
-
how much data are typically required to reach a decision.
The plot below shows the power curve across possible true effects in the population, $f_{\text{true}}$.
The red color indicates that the power to detect a true effect of the corresponding size falls below the target power of r pick_power, suggesting the design is underpowered for such effect sizes.
The green color indicates that the power meets or exceeds the target power.
This plot serves an educational purpose: it illustrates why you should choose an effect size that reflects your actual research interest. If detecting that effect requires resources beyond what's feasible, it's worth pausing to consider alternatives.
plot_cases <- df_all %>% mutate(fill_group = factor(as.integer(f_simulated))) %>% filter(f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups ) %>% filter(f_simulated != 0) %>% group_by( f_simulated, f_expected, k_groups, alpha, power, distribution, sd, sample_ratio) %>% mutate( decision_status_50 = if_else(decision != "continue sampling" & n <= q50_n, 1, 0), decision_status_75 = if_else(decision != "continue sampling" & n <= q75_n, 1, 0), decision_status_90 = if_else(decision != "continue sampling" & n <= q90_n, 1, 0), decision_status_95 = if_else(decision != "continue sampling" & n <= q95_n, 1, 0), decision_status_100 = if_else(decision != "continue sampling", 1, 0) ) %>% summarize( error_rate = mean(decision_error), mean_n = mean(n), median_n = median(n), q90_n = quantile(n, 0.90), ) %>% mutate( simulated_power = if_else(f_simulated != 0, 1 - error_rate, NA), .after = power ) # 1) Build a dense x-grid and linearly interpolate simulated_power rng <- range(plot_cases$f_simulated) grid <- tibble(f_simulated = seq(rng[1], rng[2], length.out = 1000)) grid$simulated_power <- with(plot_cases, approx(x = f_simulated, y = simulated_power, xout = grid$f_simulated, method = "linear", rule = 2)$y ) # 2) Compute above/below and y-bounds for one ribbon layer shade <- grid %>% mutate( above = simulated_power >= pick_power, ymin = pmin(simulated_power, pick_power), ymax = pmax(simulated_power, pick_power) ) # 3) Plot: one ribbon (colored by above/below), then your original line/points ggplot() + geom_ribbon( data = shade, aes(x = f_simulated, ymin = ymin, ymax = ymax, fill = above), alpha = 0.25, colour = NA ) + scale_fill_manual(values = c(`TRUE` = light_green, `FALSE` = light_red), guide = "none") + geom_line(data = plot_cases, aes(f_simulated, simulated_power), linewidth = 1.2, colour = flatly_dark) + geom_point(data = plot_cases, aes(f_simulated, simulated_power), size = 3.8, colour = flatly_blue, fill = flatly_blue, shape = 21, stroke = 1.2) + geom_hline(yintercept = pick_power, linetype = "dashed", colour = flatly_dark) + geom_segment(aes(x = pick_f_expected, xend = pick_f_expected, y = 0, yend = 1), # Adjust yend to control where line stops linetype = "dashed", colour = flatly_dark) + annotate( "text", x = pick_f_expected, y = 1, # Position text just above the line label = expression(italic(f)[exp]), hjust = 0.5, # Center horizontally vjust = 0, # Bottom of text at y position size = base_size * 0.25, colour = flatly_dark ) + scale_y_continuous(limits = c(0, 1.1), breaks = seq(0, 1, by = 0.25), labels = scales::percent_format(accuracy = 1)) + scale_x_continuous(expand = expansion(mult = c(0.02, 0.02)), breaks = unique(plot_cases$f_simulated)) + labs( title = "Simulated power across true effect sizes", x = expression(italic(f)[true]), y = "Simulated power", subtitle = glue::glue( "<i>f</i><sub>exp</sub> = {pick_f_expected}, ", "α = 0.05, β = {pick_beta}, groups = {pick_k_groups}" ) ) + theme_minimal(base_size = base_size) + theme( text = element_text(colour = flatly_dark), # <-- sets ALL text to blue plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark), plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"), axis.title = element_text(face = "bold"), axis.text = element_text(colour = "grey20"), panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(), legend.position = "none", plot.title.position = "plot" ) -> plot if (pick_f_expected == 0.10){ plot + annotate( "text", x = min(plot_cases$f_simulated), y = pick_power, label = paste0(" target power = ", percent(pick_power)), hjust = 0, vjust = 2, size = base_size * 0.25, colour = flatly_dark ) } else if (pick_f_expected == 0.15) { plot + annotate( "text", x = max(plot_cases$f_simulated) - 0.07, y = pick_power, label = paste0(" target power = ", percent(pick_power)), hjust = 0, vjust = 2, size = base_size * 0.25, colour = flatly_dark ) } else{ plot + annotate( "text", x = min(plot_cases$f_simulated), y = pick_power + 0.1, label = paste0(" target power = ", percent(pick_power)), hjust = 0, vjust = 2, size = base_size * 0.25, colour = flatly_dark ) }
::: {.alert .alert-info} It is recommended to set $f_{\text{exp}}$ to the minimum effect of interest: power declines quickly for effects smaller than $f_{\text{exp}}$, whereas choosing a much larger $f_{\text{exp}}$ may shorten data collection but risks missing practically relevant effects just below that value. :::
II. Sample size recommendations {#chapter-2}
# pick_f_simulated <- c(0, pick_f_expected) pick_f_simulated = c(0, pick_f_expected - 0.05, pick_f_expected, pick_f_expected + 0.05) table_cases <- df_all %>% mutate( f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))), fill_group = factor(as.integer(f_simulated)) ) %>% filter( f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups, f_simulated %in% pick_f_simulated ) %>% mutate(grand_median_n = as.integer(median(n))) %>% group_by( f_simulated, f_expected, k_groups, alpha, power, distribution, sd, sample_ratio ) %>% mutate( decision_status_50 = if_else(decision != "continue sampling" & n <= quantile(n, 0.50), 1, 0), decision_status_75 = if_else(decision != "continue sampling" & n <= quantile(n, 0.75), 1, 0), decision_status_90 = if_else(decision != "continue sampling" & n <= quantile(n, 0.90), 1, 0), decision_status_95 = if_else(decision != "continue sampling" & n <= quantile(n, 0.95), 1, 0), decision_status_100 = if_else(decision != "continue sampling", 1, 0) ) %>% group_by(f_simulated, f_expected, power) %>% summarize( decision_error_rate = mean(decision_error), fix_n = as.integer(mean(fix_n)), mean_n = as.integer(round(mean(n))), median_n = as.integer(median(n)), grand_median_n = grand_median_n[1], min_n = as.integer(min(n)), max_n = max(n), decision_rate_100 = sum(decision_status_100) / n(), q25_n = as.integer(round(quantile(n, 0.25))), q50_n = as.integer(round(quantile(n, 0.50))), q75_n = as.integer(round(quantile(n, 0.75))), q80_n = as.integer(round(quantile(n, 0.80))), q85_n = as.integer(round(quantile(n, 0.85))), q90_n = as.integer(round(quantile(n, 0.90))), q95_n = as.integer(round(quantile(n, 0.95))), decision_rate_50 = sum(decision_status_50) / n(), decision_rate_75 = sum(decision_status_75) / n(), decision_rate_90 = sum(decision_status_90) / n(), decision_rate_95 = sum(decision_status_95) / n(), .groups = "drop" ) %>% mutate(decision_error_rate = round(decision_error_rate*100,1)) %>% select(-power) %>% ungroup() recommendation <- table_cases %>% filter(f_simulated %in% c(0, pick_f_expected)) %>% slice_max(order_by = .data[[pick_decision_rate_var]], n = 1, with_ties = FALSE) n_mean <- round(mean(table_cases$mean_n), 0) n_median_grand <- table_cases$grand_median_n[1] n_max <- recommendation %>% pull(.data[[pick_decision_rate_var]]) simulated_power_data <- df_all %>% mutate( f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))) ) %>% filter( f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups, f_simulated %in% pick_f_simulated ) %>% group_by(f_simulated, f_expected, power) %>% summarize( decision_error_rate_nmax = mean(if_else(decision_error == 1 & n <= n_max, 1, 0)), sd_error_n = sd(n) / sqrt(length(n)), simulated_power_nmax = mean(if_else(f_simulated != "0" & decision == "accept H1" & n <= n_max, 1, 0)), .groups = "drop" ) %>% mutate(decision_error_rate_nmax = round(decision_error_rate_nmax*100,1)) %>% mutate(simulated_power_nmax = if_else(simulated_power_nmax == 0, "-", as.character(round(simulated_power_nmax*100,1)))) %>% select(-power) table_cases <- table_cases %>% left_join(simulated_power_data, by = c("f_simulated", "f_expected")) %>% select( f_simulated, decision_error_rate, decision_error_rate_nmax, simulated_power_nmax, mean_n, median_n, grand_median_n, min_n, max_n, q75_n, q80_n, q85_n, q90_n, q95_n, fix_n ) power_nmax <- table_cases$simulated_power_nmax[table_cases$f_simulated == pick_f_expected]
In the following plot you can see a visualization of the simulated samples, where the effect in the data is either as expected or zero. For a extended version of these results see Chapter III.
This plot visualizes the distribution of sample sizes required to reach a decision in sequential and fixed testing, comparing two scenarios: when the true effect matches your expectation ($f_{\text{true}} =$ r pick_f_expected) versus when there's no effect ($f_{\text{true}} =$ 0).
The violin plots reveal substantial variability, while many sequential studies terminate early (note the low median sample size), some require substantially more data.
The red diamonds show the fixed sample size from traditional a priori power analysis as a point or reference.
In most cases, the final sample size will be close to $N_{\text{median}}$, however for the worst case one should have the resources for $N_{\text{max}}$ to have a r pick_decision_rate*100% chance to reach a decision.
pick_f_simulated <- c(0, pick_f_expected) # titles title_html <- glue("<i>f</i><sub>exp</sub> = {pick_f_expected}") caption_html <- glue( # "<i>f</i><sub>true</sub> = {pick_f_expected},<br>", "β = {pick_beta}, α = 0.05, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}" ) df_all %>% mutate(f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))), fill_group = factor(as.integer(f_simulated))) %>% filter(f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups ) %>% filter(f_simulated %in% pick_f_simulated) %>% {. ->> cases} %>% ggplot(aes(x = f_simulated, y = n)) + geom_violin(trim = FALSE, fill = light_green, scale = "count", linewidth = 0.3, alpha = 0.25) + coord_cartesian(ylim = c(0, cases$fix_n[1] * 2.5)) + geom_hline(yintercept = n_median_grand, linetype = "dashed", color = flatly_dark, linewidth = 0.8) + geom_hline(yintercept = n_max, linetype = "dashed", color = flatly_dark, linewidth = 0.8) + annotate("text", x = 2.45, y = n_median_grand + 5, label = "bar(italic(N))[median]", parse = TRUE, vjust = -0.1, size = base_size * 0.25, color = flatly_dark) + annotate("text", x = 2.45, y = n_max + 5, label = "italic(N)[max]", parse = TRUE, vjust = -0.1, size = base_size * 0.25, color = flatly_dark) + geom_point(aes(x = f_simulated, y = fix_n, color = "Fixed sample size"), position = position_dodge(0.9), shape = 18, size = 11) + geom_point(aes(x = f_simulated, y = median_n, color = "Median sample size"), position = position_dodge(0.9), shape = 15, size = 8) + labs( x = "<i>f</i><sub>true</sub>", y = "<i>N</i>", title = "Required sample sizes to reach a decision", subtitle = glue::glue( "<i>f</i><sub>exp</sub> = {pick_f_expected}, ", "α = 0.05, β = {pick_beta}, groups = {pick_k_groups}" )) + scale_color_manual( name = "Legend", values = c("Fixed sample size" = fixed_color, "Median sample size" = flatly_dark), labels = c("Fixed sample size" = "a priori power analysis", "Median sample size" = "median sample size") ) + guides( color = guide_legend(override.aes = list(size = 5)) ) + theme_minimal(base_size = base_size) + theme(text = element_text(colour = flatly_dark), plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark), plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"), plot.caption = element_markdown(), axis.title.x = element_markdown(), axis.title.y = element_markdown(angle = 180, vjust = 0.5), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), legend.position = "right", legend.text = element_text(size = base_size * 0.7) ) -> p_violin p_violin
::: {.alert .alert-info}
In short, to achieve a decision rate of r pick_decision_rate*100%,
plan for a maximum sample size of $N_{\text{max}} = r n_max$.
While you must plan for this worst-case maximum,
the median sample size is only $\bar{N}{\text{median}} =$ r n_median_grand, meaning half of the time studies will terminate before reaching $N{\text{median}}$.
Using $N_{\text{max}} = r n_max$ will yield a power of $\text{Power}{N{\text{max}}}=$ r power_nmax%, accounting for both Type II errors and non-decisions.
:::
Extended numeric details are shown in the table below. Here you can also see the influence of the required sample sizes for different decision rates.
table_cases %>% filter(f_simulated %in% pick_f_simulated) %>% select(-grand_median_n, -simulated_power_nmax, -decision_error_rate_nmax) %>% ungroup() %>% gt() %>% tab_header( title = gt::html("<i>Summary table</i>"), subtitle = gt::html(glue("<i>f</i><sub>exp</sub> = {pick_f_expected}, α = 0.05, β = {pick_beta}, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}")) ) %>% # center all data columns cols_align(align = "center", columns = everything()) %>% # center column labels and the heading tab_options( heading.align = "left" ) %>% cols_label( f_simulated = gt::html("<i>f</i><sub>true</sub>"), # f_expected = gt::html("<i>f</i><sub>exp</sub>"), decision_error_rate = "Error rate %", # decision_error_rate_nmax = gt::html("Error rate<sub>N<sub>max</sub></sub>%"), # simulated_power_nmax = gt::html("Power<sub>N<sub>max</sub></sub>%"), fix_n = html("Reference <i>N</i>:<br>fixed design"), mean_n = "Mean", median_n = "Median", min_n = "Min", max_n = "Max", # decision_rate_90 = "90% decision rate", q75_n = "75%", q80_n = "80%", q85_n = "85%", q90_n = "90%", q95_n = "95%" # decision_rate_95 = "95% decision rate" ) %>% # high-level headers (spanners) tab_spanner( label = "Sample size (N)", columns = c(mean_n, median_n, min_n, max_n) ) %>% tab_spanner( label = html("<i>N</i> to reach decision rate (%)"), columns = c(q75_n, q80_n, q85_n, q90_n, q95_n) ) %>% # tab_spanner( # label = html("Reference fixed design N"), # columns = c(fix_n) # ) %>% data_color( columns = median_n, palette = grey_blue ) %>% data_color( columns = !!pick_decision_rate_var, palette = grey_blue ) %>% data_color( columns = fix_n, palette = "darkgrey" ) %>% fmt_number( columns = where(is.double), decimals = 2 ) %>% tab_footnote( footnote = html(glue("simulated error rates when sampling continous until a decision is reached")), locations = cells_column_labels(columns = decision_error_rate) ) %>% # tab_footnote( # footnote = html(glue("simulated error rates with <i>N</i><sub>max</sub> = {n_max}")), # locations = cells_column_labels(columns = decision_error_rate_nmax) # ) %>% # tab_footnote( # footnote = html(glue("simulated power to detect an effect with <i>N</i><sub>max</sub> = {n_max}")), # locations = cells_column_labels(columns = simulated_power_nmax) # ) %>% tab_footnote( footnote = html(glue("grand median: <i>N̅</i><sub>median</sub> = {n_median_grand}")), locations = cells_column_labels(columns = median_n) ) %>% tab_footnote( footnote = html(glue("recommended <i>N</i><sub>max</sub> = {n_max}")), locations = cells_column_labels(columns = !!pick_decision_rate_var) )
For SPRTs, the power is $1-\beta$ when no maximum sample size is imposed, which is the theoretical setup for an SPRT. However, for practical resource planning, we introduce $N_{\text{max}}$, which decreases the achievable power. Therefore, we define $\text{Power}{N{\text{max}}}$ as the power calculated from simulated data, accounting for both Type II errors and non-decisions.
We generally recommend maintaining a low $\beta$ and accepting a lower decision rate to manage resource constraints, rather than relaxing the Type II error rate. Low error rates combined with a lower decision rate ensure that when the procedure reaches a decision, the result is trustworthy due to strict long-run error control. Importantly, non-decisions preserve flexibility: as long as no decision has been reached, data collection can continue if additional resources become available.
III. Extended insights {#chapter-3}
Plot: Sample size and varing $f_{\text{true}}$ {#plot .toc-only}
pick_f_simulated = c(0, pick_f_expected - 0.05, pick_f_expected, pick_f_expected + 0.05)
This violin plot shows the distribution of required sample sizes $n$ across simulations for different assumed true effects $f_{\text{true}}$. The violin colors indicate whether the test controls the error rates reliably at a given setting.
-
Green marks settings where $f_{\text{true}} \geq f_{\text{exp}}$ (or $f_{\text{true}} = 0$), at which the test reliably controls the error rates.
-
Red marks settings where the $f_{\text{true}} < f_{\text{exp}}$ (and $f_{\text{true}} \neq 0$), at which the test no longer reliably controls the error rates and such effects would often go undetected. This is analogous to an underpowered fixed design: the test was not designed for effects this small, and it is not clear what the correct decision would be in such cases. (If
f_expected = 0.1is selected, no red violin is shown in the plot below as it is outside of the simulated scope.)
The red diamond marks the fixed sample size from an a priori power analysis, and the blue square shows the mean sample size observed across simulations.
# violin_colors <- c(light_blue, hell_rosa, light_blue, light_blue) # title_html <- glue("<i>f</i><sub>exp</sub> = {pick_f_expected}") caption_html <- glue( "β = {pick_beta}, α = 0.05,<br>", "groups = {pick_k_groups}" ) p_violin <- df_all %>% mutate( f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))), fill_label = ifelse(f_simulated == pick_f_expected - 0.05, "error rates not controlled", "error rates controlled") ) %>% filter( f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups ) %>% filter(f_simulated %in% pick_f_simulated) %>% ggplot(aes(x = as.factor(f_simulated), y = n, fill = fill_label)) + # violins (fill legend only) geom_violin( trim = FALSE, scale = "count", # draw_quantiles = c(0.25, 0.50, 0.75), # linewidth = 0.1, color = "lightgrey", alpha = 0.25 ) + scale_fill_manual( name = "Power", values = c("error rates controlled" = light_green, "error rates not controlled" = light_red) ) + # red diamond = fixed sample size geom_point( aes(y = fix_n, color = "Fixed sample size"), position = position_dodge(0.9), shape = 18, # diamond, no border size = 7, stroke = 0 # ensures no black outline ) + # blue square = mean sample size geom_point( aes(y = median_n, color = "Median sample size"), position = position_dodge(0.9), shape = 15, # square, no border size = 6, stroke = 0 # ensures no black outline ) + scale_color_manual( name = "Legend", values = c("Fixed sample size" = fixed_color, "Median sample size" = flatly_dark), labels = c("Fixed sample size" = "a priori power analysis", "Median sample size" = "median sample size") ) + labs( x = "<i>f</i><sub>true</sub>", y = "<i>N</i>", title = "Required sample sizes to reach a decision", subtitle = glue::glue( "<i>f</i><sub>exp</sub> = {pick_f_expected}, ", "α = 0.05, β = {pick_beta}, groups = {pick_k_groups}" ) ) + # clean legend appearance guides( fill = guide_legend(override.aes = list(shape = NA)), # patches only color = guide_legend(override.aes = list(stroke = 0, size = 5)) # points only ) + theme_minimal(base_size = base_size) + theme( text = element_text(colour = flatly_dark), legend.key = element_blank(), # no background box around keys legend.text = element_text(size = base_size * 0.7), # plot.title = element_markdown(), # plot.subtitle = element_markdown(), plot.caption = element_markdown(), axis.title.x = element_markdown(), axis.title.y = element_markdown(angle = 180, vjust = 0.5), # panel.grid.minor.y = element_blank(), panel.grid.minor.x = element_blank(), panel.grid.major.x = element_blank(), plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark), plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40") ) p_violin
Extended numeric details are shown in the table below. Here you can also see the influence of the required sample sizes for different decision rates.
num_cols <- c("f_simulated", "decision_error_rate") table_cases %>% select(-grand_median_n, -simulated_power_nmax, -decision_error_rate_nmax) %>% ungroup() %>% gt() %>% tab_header( title = gt::html("<i>Summary table</i>"), subtitle = gt::html(glue("<i>f</i><sub>exp</sub> = {pick_f_expected}, α = 0.05, β = {pick_beta}, decision rate = {pick_decision_rate*100}%, groups = {pick_k_groups}")) ) %>% cols_align(align = "center", columns = everything()) %>% tab_options( heading.align = "left" ) %>% cols_label( f_simulated = gt::html("<i>f</i><sub>true</sub>"), decision_error_rate = "Error rate %", fix_n = html("Reference <i>N</i>:<br>fixed design"), mean_n = "Mean", median_n = "Median", min_n = "Min", max_n = "Max", q75_n = "75%", q80_n = "80%", q85_n = "85%", q90_n = "90%", q95_n = "95%" ) %>% tab_spanner( label = "Sample size (N)", columns = c(mean_n, median_n, min_n, max_n) ) %>% tab_spanner( label = html("<i>N</i> to reach decision rate (%)"), columns = c(q75_n, q80_n, q85_n, q90_n, q95_n) ) %>% data_color( columns = all_of(num_cols), rows = as.numeric(as.character(f_simulated)) < pick_f_expected & as.numeric(as.character(f_simulated)) != 0, colors = light_red, alpha = 0.25, autocolor_text = FALSE ) %>% data_color( columns = median_n, palette = grey_blue ) %>% data_color( columns = !!pick_decision_rate_var, palette = grey_blue ) %>% data_color( columns = fix_n, palette = "darkgrey" ) %>% fmt_number( columns = where(is.double), decimals = 2 ) %>% tab_footnote( footnote = html(glue("simulated error rates when sampling continuous until a decision is reached")), locations = cells_column_labels(columns = decision_error_rate) )
Plot: Sample size and varing $f_{\text{exp}}$ {#sample-size-diff .toc-only}
The next plot below visualizes the required sample sizes, when the true value is set and one uses different specification of $f_{\text{exp}}$. Here you can see how the specification of $f_{\text{exp}}$ influences the sample sizes also in direct comparison to a fixed sample plan. Sequential designs maintain efficiency despite underestimating $f_{\text{true}}$, whereas fixed designs are locked into their initial specification -- a key advantage demonstrated in this plot
pick_f_simulated = pick_f_expected # titles title_html <- glue("<i>f</i><sub>true</sub> = {pick_f_simulated}") subtitle_html <- glue( # "<i>f</i><sub>true</sub> = {pick_f_expected},<br>", "β = {pick_beta}, α = 0.05,<br> groups = {pick_k_groups}" ) df_all %>% mutate(f_simulated = factor(f_simulated, levels = sort(unique(pick_f_simulated))), fill_group = factor(as.integer(f_simulated)) ) %>% filter(f_simulated == pick_f_simulated, f_expected <= pick_f_simulated, power == pick_power, k_groups == pick_k_groups ) %>% mutate(violin_color = if_else(f_expected < pick_f_expected & f_expected != 0, light_green, light_green), f_expected = factor(f_expected)) %>% group_by(f_expected) %>% {. ->> cases} %>% ggplot(aes(x = f_expected, y = n)) + geom_violin(aes(fill = violin_color), trim = FALSE, scale = "count", linewidth = 0.3, alpha = 0.25) + scale_fill_identity() + geom_point(aes(x = f_expected, y = fix_n, color = "Fixed sample size"), position = position_dodge(0.9), shape = 18, size = 9) + geom_point(aes(x = f_expected, y = median_n, color = "Median sample size"), position = position_dodge(0.9), shape = 15, size = 6) + labs( x = "<i>f</i><sub>exp</sub>", y = "<i>N</i>", title = "Required sample sizes to reach a decision", subtitle = glue::glue( "<i>f</i><sub>true</sub> = {pick_f_simulated}, ", "α = 0.05, β = {pick_beta}, groups = {pick_k_groups}" )) + scale_color_manual( name = "Legend", values = c("Fixed sample size" = fixed_color, "Median sample size" = flatly_dark), labels = c("Fixed sample size" = "a priori power analysis", "Median sample size" = "median sample size") ) + guides( color = guide_legend(override.aes = list(size = 5)) ) + theme_minimal(base_size = base_size) + theme(text = element_text(colour = flatly_dark), plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark), plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"), plot.caption = element_markdown(), axis.title.x = element_markdown(), axis.title.y = element_markdown(angle = 180, vjust = 0.5), panel.grid.minor.y = element_blank(), panel.grid.major.x = element_blank(), legend.position = "right", legend.text = element_text(size = base_size * 0.7) ) -> p_violin p_violin
Plot: Cumulative decisions {#extended-cumulative .toc-only}
This plot illustrates how decision rate accumulates with increasing sample size for different true effects. Larger effects reach the 90% decision threshold much earlier, while smaller effects require substantially more data. The vertical line marks the fixed sample size. Notice how efficiency varies depending on whether the true effect is larger, equal to, or smaller than your expected effect.
df_cum <- df_all %>% filter(f_expected == pick_f_expected, power == pick_power, k_groups == pick_k_groups) %>% filter(decision != "continue sampling") %>% transmute(f_simulated, fix_n, n_decision = n) %>% group_by(f_simulated) %>% arrange(n_decision, .by_group = TRUE) %>% mutate(cum_prop = row_number() / n()) %>% ungroup() %>% mutate( is_expected = f_simulated == pick_f_expected, f_label = ifelse(is_expected, paste0(f_simulated, " (=expected)"), as.character(f_simulated)) ) # Find the minimum n that achieves at least 90% decided cut90 <- df_cum %>% group_by(f_simulated) %>% summarise(n_at_90 = min(n_decision[cum_prop >= 0.90]), .groups = "drop") # Get Set2 palette colors set2_colors <- RColorBrewer::brewer.pal(n = length(unique(df_cum$f_label)), name = "Set2") # Create named vector with flatly_dark for expected line color_values <- setNames(set2_colors, sort(unique(df_cum$f_label))) expected_label <- paste0(pick_f_expected, " (= expected)") color_values[expected_label] <- flatly_dark # Plot with unified legend ggplot(df_cum, aes(x = n_decision, y = cum_prop, colour = f_label, group = f_simulated, linewidth = is_expected, alpha = is_expected)) + geom_step() + scale_linewidth_manual(values = c("FALSE" = 0.9, "TRUE" = 1.8), guide = "none") + scale_alpha_manual(values = c("FALSE" = 0.5, "TRUE" = 1.0), guide = "none") + # geom_hline(yintercept = 0.90, linetype = "dotted", colour = flatly_dark) + geom_vline(xintercept = unique(df_cum$fix_n), color = flatly_dark, linetype = "dashed") + annotate( "text", x = unique(df_cum$fix_n) + (unique(df_cum$fix_n) * 0.07), y = 0.05, label = "fixed sample size", angle = 90, hjust = 0.25, vjust = 1.3, size = base_size * 0.25, colour = flatly_dark ) + scale_y_continuous( limits = c(0, 1), breaks = c(0, 0.25, 0.5, 0.75, 0.9, 1), labels = percent_format(accuracy = 1) ) + scale_color_manual(values = color_values, name = expression(italic(f)[true])) + labs( x = "<i>N</i>", y = "", title = "Cumulative decision proportions across simulated\neffect sizes", subtitle = glue::glue( "<i>f</i><sub>exp</sub> = {pick_f_expected}, ", "α = 0.05, β = {pick_beta}, groups = {pick_k_groups}" ) ) + theme_minimal(base_size = base_size) + theme( plot.title = element_text(face = "bold", size = base_size, hjust = 0, colour = flatly_dark), plot.subtitle = ggtext::element_markdown(size = base_size*0.7, colour = "grey40"), panel.grid.minor = element_blank(), panel.grid.major.x = element_blank(), legend.title = element_text(face = "bold"), axis.title = element_text(face = "bold"), plot.title.position = "plot", axis.title.x = ggtext::element_markdown() )
Try the sprtt package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.