The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]dogado.de.
shrinkr lets you apply Bayesian hierarchical shrinkage to group-specific estimates in a modular, two-stage workflow:
Why use shrinkr?
Imagine a clinical trial run independently in 5 regions. Each region estimated a treatment effect, and now you want to apply shrinkage analysis.
First, let’s create synthetic trial data:
library(rstan)
set.seed(1104)
true_mu <- 0.5
true_tau <- 0.3
true_effects <- c(0.45, 0.72, 0.38, 0.55, 0.61)
regions <- c("North", "South", "East", "West", "Central")
n_per_region <- c(100, 80, 120, 90, 70)
trial_data <- lapply(seq_along(regions), function(i) {
n <- n_per_region[i]
data.frame(
region = regions[i],
treatment = rep(c(0, 1), each = n/2),
outcome = c(
rnorm(n/2, mean = 0, sd = 1),
rnorm(n/2, mean = true_effects[i], sd = 1)
)
)
}) %>% bind_rows()#> region treatment outcome
#> 1 North 0 -0.04382439
#> 2 North 0 0.64111730
#> 3 North 0 -0.33395868
#> 4 North 0 -2.60279243
#> 5 North 0 1.17838867
#> 6 North 0 -0.20705477
#>
#> 0 1
#> Central 35 35
#> East 60 60
#> North 50 50
#> South 40 40
#> West 45 45
Now we write a Stan model with treatment-by-region interaction:
stan_code <- "
data {
int<lower=0> N;
int<lower=1> G;
vector[N] y;
vector[N] treatment;
array[N] int<lower=1,upper=G> region;
}
parameters {
vector[G] beta_region;
real<lower=0> sigma;
}
model {
// IMPORTANT: Flat prior on beta_region - critical for the two-stage approach!
sigma ~ normal(0, 2);
for (n in 1:N) {
y[n] ~ normal(treatment[n] * beta_region[region[n]], sigma);
}
}
"regions <- c("North", "South", "East", "West", "Central")
region_indices <- as.integer(factor(trial_data$region, levels = regions))
fit_stan <- stan(
model_code = stan_code,
data = list(
N = nrow(trial_data), G = length(regions),
y = trial_data$outcome, treatment = trial_data$treatment,
region = region_indices
),
chains = 4, iter = 2000, warmup = 1000, refresh = 0, seed = 123
)
beta_draws <- rstan::extract(fit_stan, pars = "beta_region")$beta_region
samples_list <- lapply(seq_along(regions), function(i) beta_draws[, i])
names(samples_list) <- regions
samples <- lapply(samples_list, function(x) matrix(x, ncol = 1))Let’s examine what we got from Stage 1:
stage1_summary <- data.frame(
region = regions,
mean = sapply(samples, mean),
sd = sapply(samples, sd),
lower = sapply(samples, function(x) quantile(x, 0.025)),
upper = sapply(samples, function(x) quantile(x, 0.975))
)
print(stage1_summary)#> region mean sd lower upper
#> North North 0.6040241 0.1405588 0.33617456 0.8799941
#> South South 0.6000233 0.1540522 0.29866430 0.8924705
#> East East 0.6152066 0.1265935 0.36515463 0.8666375
#> West West 0.7049122 0.1494923 0.41466597 0.9940618
#> Central Central 0.3626256 0.1676080 0.02935275 0.6966270
Stage 1 visualization:
ggplot(stage1_summary, aes(x = region, y = mean)) +
geom_hline(yintercept = 0, linetype = "dashed", color = "gray50") +
geom_pointrange(aes(ymin = lower, ymax = upper),
size = 0.8, color = "steelblue") +
labs(
title = "Stage 1: Independent Regional Estimates",
subtitle = "Each region analyzed separately with flat priors",
x = "Region", y = "Treatment Effect",
caption = "Points show posterior means; bars show 95% credible intervals"
) +
theme_minimal(base_size = 12)Notice: Central has the widest interval (n=70) and East the narrowest (n=120). Estimates vary considerably — hierarchical shrinkage will borrow strength across regions.
Check the approximation quality:
hierarchical_priors <- list(
mu = dist_normal(0, 1),
tau = dist_truncated(dist_student_t(3, 0, 0.5), lower = 0)
)Check prior implications before fitting:
prior_pred <- sample_prior_predictive(
hierarchical_priors = hierarchical_priors,
n_groups = 5,
n_draws = 1000
)cat("Prior on tau (between-region SD):\n")
cat(" Median:", round(median(prior_pred$tau), 2), "\n")
cat(" 95% interval:", round(quantile(prior_pred$tau, c(0.025, 0.975)), 2), "\n\n")
cat("Implied variation in regional effects:\n")
cat(" Typical range:", round(median(prior_pred$implied_range), 2), "\n")
cat(" 95% interval:", round(quantile(prior_pred$implied_range, c(0.025, 0.975)), 2), "\n")#> Prior on tau (between-region SD):
#> Median: 0.38
#> 95% interval: 0.02 1.95
#> Implied variation in regional effects:
#> Typical range: 0.81
#> 95% interval: 0.03 4.83
Check what the prior implies about pairwise subgroup differences:
The implied_range above measures max(theta) - min(theta)
across all groups for each draw. For a more detailed view,
prior_pairwise_differences() computes the distribution of
|theta_i - theta_j| for every pair of groups. This is particularly
useful for calibrating whether your prior places reasonable probability
on clinically meaningful differences.
pw <- prior_pairwise_differences(prior_pred)
print(pw)
#> == Prior Predictive: Pairwise |theta_i - theta_j| ==
#>
#> Groups: 5
#> Pairs: 10
#> Draws: 1000
#>
#> Overall quantiles of |theta_i - theta_j|:
#> q2.5 = 0.005, q25 = 0.094, q50 = 0.302, q75 = 0.752, q97.5 = 2.958
#>
#> Per-pair summary:
#> # A tibble: 10 × 6
#> pair median q2.5 q97.5 prob_gt_0.5 prob_gt_1
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 group1 vs group2 0.314 0.00517 2.94 0.364 0.185
#> 2 group1 vs group3 0.320 0.00507 2.93 0.37 0.182
#> 3 group1 vs group4 0.318 0.00522 3.02 0.362 0.193
#> 4 group1 vs group5 0.298 0.00463 2.95 0.376 0.177
#> 5 group2 vs group3 0.316 0.00555 2.81 0.361 0.185
#> 6 group2 vs group4 0.297 0.00444 2.71 0.35 0.172
#> 7 group2 vs group5 0.297 0.00569 3.07 0.36 0.189
#> 8 group3 vs group4 0.306 0.00333 2.92 0.368 0.167
#> 9 group3 vs group5 0.294 0.00443 3.04 0.336 0.159
#> 10 group4 vs group5 0.277 0.00573 2.90 0.341 0.164
#>
#> -----------------------------------------------------
#> Use plot() to visualizeThe prob_gt_0.5 and prob_gt_1 columns in
the summary show the prior probability of observing pairwise differences
exceeding those thresholds — useful for assessing whether your prior is
consistent with your clinical expectations about subgroup
heterogeneity.
fit <- shrink(
mixture = mix,
hierarchical_priors = hierarchical_priors,
chains = 4,
iter = 2000,
warmup = 1000,
seed = 456,
refresh = 0
)
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 1).
#> Chain 1:
#> Chain 1: Gradient evaluation took 8e-06 seconds
#> Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
#> Chain 1: Adjust your expectations accordingly!
#> Chain 1:
#> Chain 1:
#> Chain 1: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 1: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 1: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 1: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 1: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 1: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 1: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 1: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 1: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 1: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 1: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 1: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 1: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 1: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 1: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 1: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 1: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 1: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 1: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 1: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 1: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 1: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 1:
#> Chain 1: Elapsed Time: 0.093 seconds (Warm-up)
#> Chain 1: 0.087 seconds (Sampling)
#> Chain 1: 0.18 seconds (Total)
#> Chain 1:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 2).
#> Chain 2:
#> Chain 2: Gradient evaluation took 9e-06 seconds
#> Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.09 seconds.
#> Chain 2: Adjust your expectations accordingly!
#> Chain 2:
#> Chain 2:
#> Chain 2: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 2: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 2: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 2: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 2: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 2: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 2: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 2: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 2: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 2: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 2: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 2: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 2: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 2: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 2: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 2: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 2: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 2: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 2: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 2: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 2: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 2: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 2:
#> Chain 2: Elapsed Time: 0.097 seconds (Warm-up)
#> Chain 2: 0.059 seconds (Sampling)
#> Chain 2: 0.156 seconds (Total)
#> Chain 2:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 3).
#> Chain 3:
#> Chain 3: Gradient evaluation took 6e-06 seconds
#> Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.06 seconds.
#> Chain 3: Adjust your expectations accordingly!
#> Chain 3:
#> Chain 3:
#> Chain 3: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 3: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 3: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 3: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 3: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 3: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 3: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 3: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 3: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 3: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 3: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 3: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 3: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 3: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 3: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 3: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 3: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 3: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 3: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 3: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 3: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 3: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 3:
#> Chain 3: Elapsed Time: 0.096 seconds (Warm-up)
#> Chain 3: 0.072 seconds (Sampling)
#> Chain 3: 0.168 seconds (Total)
#> Chain 3:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 4).
#> Chain 4:
#> Chain 4: Gradient evaluation took 7e-06 seconds
#> Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
#> Chain 4: Adjust your expectations accordingly!
#> Chain 4:
#> Chain 4:
#> Chain 4: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 4: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 4: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 4: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 4: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 4: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 4: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 4: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 4: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 4: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 4: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 4: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 4: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 4: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 4: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 4: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 4: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 4: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 4: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 4: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 4: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 4: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 4:
#> Chain 4: Elapsed Time: 0.104 seconds (Warm-up)
#> Chain 4: 0.078 seconds (Sampling)
#> Chain 4: 0.182 seconds (Total)
#> Chain 4:
print(fit)
#> # A tibble: 3 × 7
#> variable mean sd q2.5 q50 q97.5 rhat
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 mu 0.583 0.0890 0.402 0.586 0.763 1.00
#> 2 tau 0.109 0.0973 0.00380 0.0827 0.368 1.00
#> 3 tau_squared 0.0214 0.0408 0.0000144 0.00684 0.136 1.00mu_tau <- extract_mu_tau(fit)
cat("Overall treatment effect (mu):\n")
#> Overall treatment effect (mu):
cat(" Mean:", round(mean(mu_tau$mu), 3), "\n")
#> Mean: 0.583
cat(" 95% CI:", round(quantile(mu_tau$mu, c(0.025, 0.975)), 3), "\n\n")
#> 95% CI: 0.402 0.763
cat("Between-region heterogeneity (tau):\n")
#> Between-region heterogeneity (tau):
cat(" Mean:", round(mean(mu_tau$tau), 3), "\n")
#> Mean: 0.109
cat(" 95% CI:", round(quantile(mu_tau$tau, c(0.025, 0.975)), 3), "\n")
#> 95% CI: 0.004 0.368theta_summary <- summarize_theta(fit)
print(theta_summary)
#> # A tibble: 5 × 9
#> group mean sd q2.5 q50 q97.5 rhat ess_bulk ess_tail
#> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
#> 1 North 0.590 0.0980 0.400 0.590 0.790 1.00 4037. 2233.
#> 2 South 0.587 0.101 0.384 0.587 0.792 1.00 3329. 1901.
#> 3 East 0.596 0.0879 0.427 0.594 0.778 1.00 4630. 3305.
#> 4 West 0.621 0.102 0.434 0.612 0.851 1.00 3943. 3258.
#> 5 Central 0.523 0.121 0.244 0.538 0.721 1.00 3389. 2517.If you only have published means and standard errors (no full posteriors), you can use the MLE approach:
mle_estimates <- sapply(samples, mean)
mle_variances <- sapply(samples, var)
fit_mle <- shrink(
mle = mle_estimates,
var_matrix = mle_variances,
hierarchical_priors = hierarchical_priors,
chains = 4,
iter = 2000,
warmup = 1000,
seed = 456,
refresh = 0
)
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 1).
#> Chain 1:
#> Chain 1: Gradient evaluation took 8e-06 seconds
#> Chain 1: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
#> Chain 1: Adjust your expectations accordingly!
#> Chain 1:
#> Chain 1:
#> Chain 1: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 1: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 1: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 1: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 1: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 1: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 1: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 1: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 1: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 1: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 1: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 1: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 1: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 1: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 1: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 1: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 1: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 1: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 1: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 1: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 1: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 1: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 1:
#> Chain 1: Elapsed Time: 0.087 seconds (Warm-up)
#> Chain 1: 0.076 seconds (Sampling)
#> Chain 1: 0.163 seconds (Total)
#> Chain 1:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 2).
#> Chain 2:
#> Chain 2: Gradient evaluation took 8e-06 seconds
#> Chain 2: 1000 transitions using 10 leapfrog steps per transition would take 0.08 seconds.
#> Chain 2: Adjust your expectations accordingly!
#> Chain 2:
#> Chain 2:
#> Chain 2: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 2: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 2: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 2: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 2: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 2: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 2: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 2: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 2: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 2: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 2: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 2: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 2: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 2: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 2: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 2: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 2: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 2: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 2: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 2: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 2: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 2: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 2:
#> Chain 2: Elapsed Time: 0.098 seconds (Warm-up)
#> Chain 2: 0.096 seconds (Sampling)
#> Chain 2: 0.194 seconds (Total)
#> Chain 2:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 3).
#> Chain 3:
#> Chain 3: Gradient evaluation took 7e-06 seconds
#> Chain 3: 1000 transitions using 10 leapfrog steps per transition would take 0.07 seconds.
#> Chain 3: Adjust your expectations accordingly!
#> Chain 3:
#> Chain 3:
#> Chain 3: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 3: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 3: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 3: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 3: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 3: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 3: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 3: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 3: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 3: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 3: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 3: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 3: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 3: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 3: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 3: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 3: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 3: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 3: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 3: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 3: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 3: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 3:
#> Chain 3: Elapsed Time: 0.084 seconds (Warm-up)
#> Chain 3: 0.082 seconds (Sampling)
#> Chain 3: 0.166 seconds (Total)
#> Chain 3:
#>
#> SAMPLING FOR MODEL 'stage2_shrinkage' NOW (CHAIN 4).
#> Chain 4:
#> Chain 4: Gradient evaluation took 1.1e-05 seconds
#> Chain 4: 1000 transitions using 10 leapfrog steps per transition would take 0.11 seconds.
#> Chain 4: Adjust your expectations accordingly!
#> Chain 4:
#> Chain 4:
#> Chain 4: Iteration: 1 / 2000 [ 0%] (Warmup)
#> Chain 4: Iteration: 100 / 2000 [ 5%] (Warmup)
#> Chain 4: Iteration: 200 / 2000 [ 10%] (Warmup)
#> Chain 4: Iteration: 300 / 2000 [ 15%] (Warmup)
#> Chain 4: Iteration: 400 / 2000 [ 20%] (Warmup)
#> Chain 4: Iteration: 500 / 2000 [ 25%] (Warmup)
#> Chain 4: Iteration: 600 / 2000 [ 30%] (Warmup)
#> Chain 4: Iteration: 700 / 2000 [ 35%] (Warmup)
#> Chain 4: Iteration: 800 / 2000 [ 40%] (Warmup)
#> Chain 4: Iteration: 900 / 2000 [ 45%] (Warmup)
#> Chain 4: Iteration: 1000 / 2000 [ 50%] (Warmup)
#> Chain 4: Iteration: 1001 / 2000 [ 50%] (Sampling)
#> Chain 4: Iteration: 1100 / 2000 [ 55%] (Sampling)
#> Chain 4: Iteration: 1200 / 2000 [ 60%] (Sampling)
#> Chain 4: Iteration: 1300 / 2000 [ 65%] (Sampling)
#> Chain 4: Iteration: 1400 / 2000 [ 70%] (Sampling)
#> Chain 4: Iteration: 1500 / 2000 [ 75%] (Sampling)
#> Chain 4: Iteration: 1600 / 2000 [ 80%] (Sampling)
#> Chain 4: Iteration: 1700 / 2000 [ 85%] (Sampling)
#> Chain 4: Iteration: 1800 / 2000 [ 90%] (Sampling)
#> Chain 4: Iteration: 1900 / 2000 [ 95%] (Sampling)
#> Chain 4: Iteration: 2000 / 2000 [100%] (Sampling)
#> Chain 4:
#> Chain 4: Elapsed Time: 0.101 seconds (Warm-up)
#> Chain 4: 0.059 seconds (Sampling)
#> Chain 4: 0.16 seconds (Total)
#> Chain 4:mu_tau_mle <- extract_mu_tau(fit_mle)
cat("Mixture approach:\n")
#> Mixture approach:
cat(" mu =", round(mean(mu_tau$mu), 3), "\n")
#> mu = 0.583
cat(" tau =", round(mean(mu_tau$tau), 3), "\n\n")
#> tau = 0.109
cat("MLE approach:\n")
#> MLE approach:
cat(" mu =", round(mean(mu_tau_mle$mu), 3), "\n")
#> mu = 0.579
cat(" tau =", round(mean(mu_tau_mle$tau), 3), "\n")
#> tau = 0.112| Method | Use When | Pros | Cons |
|---|---|---|---|
| Mixture | You have full posteriors | Captures non-normality; More accurate | Requires posterior samples |
| MLE | Only means + SEs available | Simpler; Works with published data | Assumes normality |
# 1. Write Stan model with FLAT PRIORS on parameters of interest
stan_code <- "
data {
int<lower=0> N;
int<lower=1> G;
vector[N] y;
vector[N] treatment;
array[N] int<lower=1,upper=G> group;
}
parameters {
vector[G] theta; // Group-specific effects - NO PRIOR SPECIFIED
real<lower=0> sigma;
}
model {
sigma ~ normal(0, 2);
for (n in 1:N) {
y[n] ~ normal(treatment[n] * theta[group[n]], sigma);
}
}
"
# 2. Fit model once to get all group effects, extract posteriors
group_indices <- as.integer(factor(data$group, levels = groups))
fit_stan <- stan(
model_code = stan_code,
data = list(N = nrow(data), G = length(groups),
y = data$y, treatment = data$treatment,
group = group_indices),
chains = 4, iter = 2000, warmup = 1000, refresh = 0
)
theta_draws <- extract(fit_stan)$theta
samples <- lapply(seq_along(groups), function(i) matrix(theta_draws[, i], ncol = 1))
names(samples) <- groups
# 3. Fit mixture approximation and check quality
mix <- fit_mixture(samples, K_max = 3)
plot(mix, draws = samples)
# 4. Specify and check hierarchical priors
priors <- list(
mu = dist_normal(0, 5),
tau = dist_truncated(dist_student_t(3, 0, 1), lower = 0)
)
plot(sample_prior_predictive(priors, n_groups = length(groups)))
# 5. Fit, extract, and visualize
fit <- shrink(mixture = mix, hierarchical_priors = priors)
plot(fit)
summarize_theta(fit)
extract_mu_tau(fit)plot()sample_prior_predictive() to understand implicationsplot(mix, draws = samples)sample_prior_predictive() and
plot()fit$diagnostics, Rhat, ESSvignette("tidy_bayesian_workflow") for working with
tidyverse toolsvignette("brms_integration") for survival analysis and brms
integrationvignette("federated_learning") for distributed data
analysissessionInfo()
#> R version 4.4.2 (2024-10-31 ucrt)
#> Platform: x86_64-w64-mingw32/x64
#> Running under: Windows 10 x64 (build 19045)
#>
#> Matrix products: default
#>
#>
#> locale:
#> [1] LC_COLLATE=C
#> [2] LC_CTYPE=English_United States.utf8
#> [3] LC_MONETARY=English_United States.utf8
#> [4] LC_NUMERIC=C
#> [5] LC_TIME=English_United States.utf8
#>
#> time zone: America/Chicago
#> tzcode source: internal
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> other attached packages:
#> [1] patchwork_1.3.2 posterior_1.7.0 survival_3.7-0
#> [4] lubridate_1.9.5 forcats_1.0.1 stringr_1.6.0
#> [7] dplyr_1.2.1 purrr_1.2.2 readr_2.2.0
#> [10] tidyr_1.3.2 tibble_3.3.1 ggplot2_4.0.3
#> [13] tidyverse_2.0.0 distributional_0.7.1 tidybayes_3.0.7
#> [16] brms_2.23.0 Rcpp_1.1.1 shrinkr_0.4.5
#>
#> loaded via a namespace (and not attached):
#> [1] tidyselect_1.2.1 svUnit_1.0.8 farver_2.1.2
#> [4] loo_2.9.0 S7_0.2.2 fastmap_1.2.0
#> [7] tensorA_0.36.2.1 digest_0.6.39 estimability_1.5.1
#> [10] timechange_0.4.0 lifecycle_1.0.5 StanHeaders_2.32.10
#> [13] magrittr_2.0.5 compiler_4.4.2 rlang_1.2.0
#> [16] sass_0.4.10 tools_4.4.2 utf8_1.2.6
#> [19] yaml_2.3.12 knitr_1.51 labeling_0.4.3
#> [22] bridgesampling_1.2-1 pkgbuild_1.4.8 mclust_6.1.2
#> [25] curl_7.1.0 RColorBrewer_1.1-3 abind_1.4-8
#> [28] withr_3.0.2 grid_4.4.2 stats4_4.4.2
#> [31] xtable_1.8-8 inline_0.3.21 emmeans_2.0.3
#> [34] scales_1.4.0 cli_3.6.6 mvtnorm_1.4-1
#> [37] rmarkdown_2.31 generics_0.1.4 otel_0.2.0
#> [40] RcppParallel_5.1.11-2 rstudioapi_0.19.0 tzdb_0.5.0
#> [43] cachem_1.1.0 rstan_2.32.7 splines_4.4.2
#> [46] bayesplot_1.15.0 parallel_4.4.2 matrixStats_1.5.0
#> [49] vctrs_0.7.3 V8_8.2.0 Matrix_1.7-1
#> [52] jsonlite_2.0.0 hms_1.1.4 arrayhelpers_1.1-0
#> [55] ggdist_3.3.3 jquerylib_0.1.4 glue_1.8.1
#> [58] codetools_0.2-20 stringi_1.8.7 gtable_0.3.6
#> [61] QuickJSR_1.9.2 pillar_1.11.1 htmltools_0.5.9
#> [64] Brobdingnag_1.2-9 R6_2.6.1 evaluate_1.0.5
#> [67] lattice_0.22-6 backports_1.5.1 bslib_0.11.0
#> [70] rstantools_2.6.0 coda_0.19-4.1 gridExtra_2.3
#> [73] nlme_3.1-166 checkmate_2.3.4 xfun_0.57
#> [76] pkgconfig_2.0.3These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.
Health stats visible at Monitor.