% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/api-shrinkage.R
\name{apply_empirical_bayes_shrinkage}
\alias{apply_empirical_bayes_shrinkage}
\title{Apply empirical-Bayes shrinkage to fitted non-person facet estimates}
\usage{
apply_empirical_bayes_shrinkage(
  fit,
  facet_prior_sd = NULL,
  shrink_person = FALSE
)
}
\arguments{
\item{fit}{An \code{mfrm_fit} from \code{\link[=fit_mfrm]{fit_mfrm()}} with a non-empty
\code{facets$others} table.}

\item{facet_prior_sd}{Optional numeric scalar. When supplied, the
shrinkage variance is fixed at \code{facet_prior_sd^2} instead of being
estimated from the data. Useful when a prior is elicited from
expert knowledge or a previous fit.}

\item{shrink_person}{Logical. When \code{TRUE}, the same empirical-Bayes
shrinkage is also applied to \code{fit$facets$person}. Default \code{FALSE},
since MML person estimates already reflect a N(0, sigma^2) prior.}
}
\value{
The same \code{mfrm_fit}, with augmented columns and a new
\code{shrinkage_report} list entry, and with
\code{fit$config$facet_shrinkage} set to \code{"empirical_bayes"}.
}
\description{
Post-hoc shrinkage helper that augments an \code{mfrm_fit} with James-Stein
/ empirical-Bayes shrunk estimates for each non-person facet. The
shrinkage variance \eqn{\hat{\tau}^2} is estimated by method of
moments from the facet-level point estimates and their standard
errors:
\deqn{\hat{\tau}^2 = \max\!\left(0,
  \frac{1}{K}\sum_{j=1}^{K}\hat{\delta}_j^{2} -
  \overline{\mathrm{SE}^2}\right),}
where the first term is the population variance of the facet point
estimates around their \emph{known} mean of zero (the mfrmr sum-to-zero
identification pins the facet mean exactly at 0, so no degree of
freedom is consumed by mean estimation). The shrinkage factor is
\eqn{B_j = \mathrm{SE}_j^2 / (\hat{\tau}^2 + \mathrm{SE}_j^2)}, and
the shrunk point / standard error are
\eqn{\hat{\delta}_j^{EB} = (1 - B_j)\hat{\delta}_j} and
\eqn{\mathrm{SE}_j^{EB} = \sqrt{(1 - B_j)\mathrm{SE}_j^2}}.
The posterior SE form treats \eqn{\hat{\tau}^2} as known; it omits
the Morris (1983, eqs. 4.1-4.2, p. 51) confidence-interval correction
\eqn{v \cdot \hat{\delta}_j^{2}} with
\eqn{v = 2 B_j^2 / (K - r - 2)}, where \eqn{r} is the number of
regression coefficients used to model the prior mean (under mfrmr's
sum-to-zero pinning, \eqn{r = 0}, so the divisor is \eqn{K - 2}).
This correction adds variance proportional to the squared deviation
\eqn{\hat{\delta}_j^{2}}, accounting for uncertainty in
\eqn{\hat{\tau}^2}. Under the equal-variance assumption
\eqn{\hat{\delta}_j^{2} \approx \hat{\tau}^2}, the omitted variance is
on the order of \eqn{2 / (K - 2)} times the reported posterior
variance \eqn{V(1 - B_j)}, so the true SE is approximately
\eqn{\sqrt{1 + 2/(K - 2)}} times the reported \code{ShrunkSE}. Magnitudes:
SE understated by ~73\\% at \eqn{K = 3}, ~29\\% at \eqn{K = 5}, ~15\\%
at \eqn{K = 8}, ~7\\% at \eqn{K = 15}. For a small-K facet, treat
\code{ShrunkSE} as a lower bound rather than a calibrated posterior SE.
}
\details{
\code{fit$facets$others} gains \code{ShrunkEstimate}, \code{ShrunkSE}, and
\code{ShrinkageFactor} columns, and \code{fit$shrinkage_report} records the
per-facet \eqn{\hat{\tau}^2}, mean shrinkage, and effective degrees
of freedom (\eqn{\mathrm{EffectiveDF}_f = \sum_j (1 - B_j)}, which
matches the "effective number of parameters" defined by
Efron & Morris, 1973). The original \code{Estimate} / \code{SE} columns are
preserved.
}
\section{Typical workflow}{

\enumerate{
\item Fit the model as usual with \code{fit_mfrm()}.
\item Call \code{apply_empirical_bayes_shrinkage(fit)} when small-N facets
are present (see \code{\link[=facet_small_sample_review]{facet_small_sample_review()}}).
\item Report both the original and shrunk estimates in the manuscript,
citing Efron & Morris (1973). \code{build_apa_outputs()} will add the
sentence automatically when \code{fit$config$facet_shrinkage} is set.
}
}

\examples{
toy <- load_mfrmr_data("example_core")
fit <- fit_mfrm(toy, "Person", c("Rater", "Criterion"), "Score",
                method = "JML", maxit = 30)
fit_eb <- apply_empirical_bayes_shrinkage(fit)
fit_eb$shrinkage_report
# Look for:
# - `Tau2` is the estimated between-level prior variance per facet.
#   `Tau2 = 0` means the data did not justify any pooling and the
#   shrunken estimates equal the raw estimates (`MeanShrinkage = 0`).
# - `MeanShrinkage` near 0 = little movement, near 1 = heavy pooling
#   toward 0. Small-N facets typically pull values further than
#   well-identified ones.
# - `EffectiveDF` is the implied "effective number of parameters"
#   (Efron & Morris 1973); EffectiveDF much smaller than the row
#   count of the facet means most levels were pooled together.
head(fit_eb$facets$others[, c("Facet", "Level", "Estimate",
                               "ShrunkEstimate", "ShrinkageFactor")])
# Look for: rows where `ShrinkageFactor` is large (close to 1) had
#   their estimates pulled most strongly toward the facet mean (0).
}
\references{
Efron, B., & Morris, C. (1973). Combining possibly related
estimation problems. \emph{Journal of the Royal Statistical Society:
Series B, 35}(3), 379-402.

Efron, B. (2021). \emph{Empirical Bayes: Concepts and methods}
(Technical report). Department of Statistics, Stanford University.
\url{https://efron.ckirby.su.domains/papers/2021EB-concepts-methods.pdf}

Morris, C. N. (1983). Parametric empirical Bayes inference: Theory
and applications. \emph{Journal of the American Statistical Association,
78}(381), 47-55.
}
\seealso{
\code{\link[=fit_mfrm]{fit_mfrm()}} (which accepts \code{facet_shrinkage} directly),
\code{\link[=facet_small_sample_review]{facet_small_sample_review()}}, \code{\link[=compute_facet_icc]{compute_facet_icc()}}.
}
