Skip to contents

Answer the question: when do additional topics stop paying for themselves? Comparing two topic counts on held-out fit is a paired problem: the same evaluation documents are scored under both models, so the informative quantity is the per-document gain, the difference of the two held-out scores on the same document. This function computes the paired gains between adjacent points of the topic grid, attaches their uncertainty, and applies the paper's selection rule: stop at the smallest \(K\) beyond which the certified improvement falls below a tolerance you chose in advance (Proposition 2 (iv) and Definition 1 of Lewis and Grossetti 2026).

Usage

optop_gain_table(ho, metric = "deviance", epsilon = 0.01, alpha = 0.05)

Arguments

ho

An optop_index_holdout() result.

metric

One of the metrics evaluated in ho (default "deviance", the paper's primary index).

epsilon

Positive tolerance of the adequacy rule: the held-out improvement you consider too small to justify an extra topic, on the proportional scale of the index (default 0.01, one percentage point of discrepancy reduction). Fix it before looking at the results.

alpha

One-sided level of the upper bound and the improvement test (default 0.05).

Value

A list with

  • gains: data.table with one row per adjacent pair. Reading the columns: K and succ_K are the pair compared; n the number of paired documents; gain the mean per-document improvement from K to succ_K; sd its standard deviation across documents; upper the one-sided upper confidence bound of the mean gain (the quantity the selection rule thresholds); z and pval the paired test of no improvement (small pval = the extra topics helped on average).

  • k_hat: the selected topic count, the smallest K with upper <= epsilon (NA when no grid point qualifies, meaning the grid ended before the gains died out).

  • metric, epsilon, alpha: the design.

Details

How it works.

  1. For each grid point \(K\) with successor \(succ(K)\) (the next point of the actual grid, not mechanically \(K + 1\)), the per-document gain is \(\Delta_j(K) = R^{2,ho}_j(succ(K)) - R^{2,ho}_j(K)\), computed on the same evaluation documents. Pairs are complete-case: documents excluded by the null-discrepancy floor of optop_index_holdout() (or otherwise NA) at either topic count drop from that pair, so n reports the paired documents actually used.

  2. The mean gain estimates how much held-out fit the extra topics buy; its one-sided upper confidence bound \(\bar\Delta + z_{1-\alpha}\,\hat\sigma_\Delta/\sqrt{J_+}\) says: with confidence \(1-\alpha\), the true gain is no larger than this.

  3. The selection \(\hat K_{D,\varepsilon,\alpha}\) is the smallest \(K\) whose upper bound is at most \(\varepsilon\): even in the optimistic reading of the data, moving past that \(K\) buys less than the tolerance.

The rule is a stopping rule over dependent one-sided tests: adjacent gains share evaluation documents and overlapping models, so alpha applies to each comparison separately, not to the selection event. Inference reported after selection is subject to the usual post-selection caveats; a conservative practice is to select \(K\) on one held-out sample and report fit indices and moment diagnostics on a second, disjoint evaluation sample. The rule is a practical sufficiency criterion, not an estimator of a latent true number of topics.

References

Lewis, C. M. and Grossetti, F. (2026). Goodness-of-fit indices and diagnostics for topic models. Working paper.

Examples

# \donttest{
# continue from the optop_index_holdout() example
rdir <- function(n, k, a) {
  g <- matrix(stats::rgamma(n * k, shape = a), nrow = n)
  g / rowSums(g)
}
set.seed(42)
corpus <- sim_dfm(DTW = rdir(120, 6, 0.4), TWW = rdir(6, 300, 0.1),
                  doc_length = rep(400, 120), seed = 1)
dtm_train <- corpus[1:90, ]
dtm_eval <- corpus[91:120, ]
models <- lapply(c(4, 6, 8), function(k) {
  topicmodels::LDA(dtm_train, k = k, control = list(seed = 100 + k))
})
ho <- optop_index_holdout(models, dtm_eval,
                          optop_make_baseline(dtm_train))

gt <- optop_gain_table(ho, epsilon = 0.01, alpha = 0.05)
gt$gains   # certified improvement per grid step
#>        K succ_K     n       gain        sd     upper        z         pval
#>    <num>  <num> <int>      <num>     <num>     <num>    <num>        <num>
#> 1:     4      6    30 0.07638376 0.1992782 0.1362286 2.099432 1.788941e-02
#> 2:     6      8    30 0.12712122 0.1266775 0.1651635 5.496410 1.938009e-08
gt$k_hat   # smallest K after which gains fall below epsilon
#> [1] NA
# }