# Bias when using partial pooling model to estimate standard deviation?

#1

Suppose \sigma > 0 and let N>0 be a non-negative integer (counting number of studies, say). Let y_{ij} \sim \operatorname{normal}(\mu, \sigma) for 1\leq i \leq N and 1\leq j \leq n_i, where n_i is the number of measurements in study i.

We are given S_i = \sqrt{\frac{1}{n_i -1} \sum_{j=1}^{n_i} \left(y_{ij} - Y_i\right)^2} with Y_i = \frac{1}{n_i} \sum_{j=1}^{n_i} y_{ij} for all i.

Based on the observations S_i I would now like to infer \sigma. I came up with the following hierarchical model

data {
int<lower=1> N; 	         // total number of studies
vector<lower=1>[N] NSamples; // Number of samples per study
vector<lower=0>[N] Stds;	 // Standard deviations
real scale_cauchy;           // used in cauchy hyper prior
}
parameters {
real mu_hyp;
real<lower=0> sigma_hyp;
vector[N] log_sigmas_raw;
}
transformed parameters {
vector<lower=0>[N] sigmas = exp(mu_hyp + sigma_hyp*log_sigmas_raw);
}
model {
vector[N] c_stat;
mu_hyp ~ cauchy(0,scale_cauchy);
sigma_hyp ~ cauchy(0,scale_cauchy) T[0,];
log_sigmas_raw ~ normal(0,1);
c_stat = (NSamples - 1) .* square(Stds ./ sigmas);
c_stat ~ chi_square(NSamples-1);
}


I used the following R code to simulate and check how well the Stan model can recover the parameter \sigma.

library(rstan)
library(tidyverse)
sm_pp <- stan_model("partial_pooling.stan")

run_sd_pp <- function(sm_pp, sigma, mu=50, NStudies=100, MaxSamplesPerStudy=1000, p=0.3, scale_cauchy=1.) {
SizePerStudy <- rbinom(NStudies, MaxSamplesPerStudy, p)
samples_per_study <- map(1:NStudies, ~rnorm(SizePerStudy[.], mu, sigma) )
sds <- map_dbl(samples_per_study, sd)
means <- map_dbl(samples_per_study, mean)
stan_data <- list(
NSamples = SizePerStudy,
Stds = sds,
N = NStudies,
scale_cauchy=scale_cauchy
)
fit_pp <- sampling(sm_pp, data=stan_data, iter=4000, chains=4, cores=2, control=list(adapt_delta=.9))
post_pp <- as.array(fit_pp)
quantile(exp(as.vector(post_pp[,,"mu_hyp"])),probs = c(0.025, .5, .975))
}
sigma <- 2
rslts_pp <- map(1:100, ~run_sd_pp(sm_pp, sigma=sigma))
diffs_pp <- map_dbl(1:100, ~rslts_pp[[.]][["50%"]] - sigma)


What surprised me is that I observe that in roughly 20 percent of the cases the posterior-median of exp(mu_hyp) is smaller than the true \sigma but in roughly 80 percent of the cases it is larger than the true \sigma.

This surprised me, since I was expecting that the median estimate should have roughly equal probability of under-/overestimating the true sigma. Does this indicate that my model has a bias? By the way, I observe the same when I use the following complete pooling model (and using the posterior median of sigma as a point estimate):

data {
int<lower=1> N;
vector<lower=1>[N] NSamples;
vector<lower=0>[N] Stds;
}
parameters {
real<lower=0> sigma;
}
model {
vector[N] c_stat;
c_stat = (NSamples - 1) .* square(Stds / sigma);
sigma ~ normal(100,100);
c_stat ~ chi_square(NSamples-1);
}


Regarding calibration, I observe that the 95 percent posterior credible interval for exp(mu_hyp) (or sigma in the complete pooling case) contains in (roughly) 94 percent of the cases the true sigma, which I presume is a good sign.

#2

To give some more background, what underlies both models is Cochranâ€™s theorem, here.