fix(sensitivity): make the run-to-run noise window symmetric in the two refits

NEWS.md

@@ -79,6 +79,14 @@ released from this line yet.
   so the 1x anchor still contributes, `$grid` records the true gate result
   together with a `forced` flag.
 
+* The run-to-run noise band of `prior_sensitivity_check()` pools the edges
+  that are threshold-relevant in both refits, and counts an edge inside the
+  window in only one of them as censored, whichever refit that is. It
+  previously selected edges on the first refit alone, so an edge that
+  saturated in the replicate but not in the first refit could carry the band
+  up, and the reverse case was dropped silently. The band and the
+  within-noise classification can change for edges near the thresholds.
+
 * `calibration_check()` rejects `newdata` values outside the fit's support,
   naming the variable and the offending values; both branches previously
   failed silently (`NA` through the isotonic fit in the ordinal branch, silent

R/prior_sensitivity.R

@@ -101,13 +101,12 @@ verdict_from_bf = function(bf, threshold) {
 #' chain-level spread of the reweighted estimate (so it carries both the
 #' between-chain and the importance-sampling uncertainty) and the noise band
 #' the 95th percentile of the spread between one anchor refit and its
-#' repeat, over threshold-relevant edges
-#' (\eqn{|\log \mathrm{BF}| \le 3 \log 10 \approx 6.91}; near-saturated edges would
-#' inflate it). An edge that is threshold-relevant in one of the two refits and
-#' saturated in the other has a censored rather than an infinite spread, and is
-#' left out of that percentile; the printed report counts them. When no
-#' threshold-relevant edge has a measurable spread the noise band is \code{NA}
-#' and the mover rule falls back to \code{max(tolerance, 2 * MCSE)}.
+#' repeat, over the edges with \eqn{|\log \mathrm{BF}| \le 3 \log 10 \approx 6.91}
+#' in both refits (near-saturated edges are excluded because their log Bayes
+#' factor jumps between identical runs). An edge inside that window in one
+#' refit only is left out of the percentile and counted; the printed report
+#' gives the count. When no edge qualifies the noise band is \code{NA} and the
+#' mover rule falls back to \code{max(tolerance, 2 * MCSE)}.
 #' The \code{$edges$mover} column stores \code{stable},
 #' \code{indistinguishable-from-wobble}, or \code{moved-beyond-wobble}; the
 #' printed report shows the same categories in plain language ("robust",
@@ -872,35 +871,36 @@ order_upper_tri_rowmajor = function(p) {
 # ------------------------------------------------------------------
 # wobble_yardstick
 # ------------------------------------------------------------------
-# Monte Carlo wobble from the chosen-scale refit and its replicate. The
-# q95 pools threshold-relevant edges only (|log BF| <= 3 log(10) at s0,
-# the former 3-log10 window in natural log units):
-# near-saturated edges have an exploding log-odds derivative, and their
-# replicate spread would inflate the yardstick past any genuine
-# scale-driven move. The per-edge spread and its median cover all edges.
+# Monte Carlo wobble from the chosen-scale refit and its replicate.
+#
+# per_edge  |log BF_1 - log BF_2| for every edge.
+# q95       95th percentile of per_edge over the edges with
+#           |log BF| <= 3 log(10) in both refits. Near-saturated edges
+#           are excluded: their log BF jumps between identical runs.
+# censored  number of edges with |log BF| <= 3 log(10) in one refit only.
+# median    median of per_edge over all edges with a finite spread.
 #
 # @param lbf_s0   Per-edge natural log BF from the chosen-scale refit.
 # @param lbf_rep  Per-edge natural log BF from the s0 replicate.
 #
-# Returns: list(q95, median, per_edge); q95 is NA when no edge is
-# threshold-relevant.
+# Returns: list(q95, median, per_edge, censored); q95 is NA when no edge
+# qualifies.
 # ------------------------------------------------------------------
 wobble_yardstick = function(lbf_s0, lbf_rep) {
   per_edge = abs(lbf_s0 - lbf_rep)
-  relevant = is.finite(lbf_s0) & abs(lbf_s0) <= 3 * log(10)
-  # An edge that is threshold-relevant in one refit and saturated in the other
-  # has a censored spread, not an infinite one. Pooling it would carry the
-  # yardstick to Inf, which classes every verdict move as run-to-run noise.
-  measurable = relevant & is.finite(per_edge)
+  window = 3 * log(10)
+  in_window_1 = is.finite(lbf_s0) & abs(lbf_s0) <= window
+  in_window_2 = is.finite(lbf_rep) & abs(lbf_rep) <= window
+  eligible = in_window_1 & in_window_2
   list(
-    q95 = if(any(measurable)) {
-      stats::quantile(per_edge[measurable], 0.95, names = FALSE)
+    q95 = if(any(eligible)) {
+      stats::quantile(per_edge[eligible], 0.95, names = FALSE)
     } else {
       NA_real_
     },
     median = stats::median(per_edge[is.finite(per_edge)]),
     per_edge = per_edge,
-    censored = sum(relevant & !is.finite(per_edge))
+    censored = sum((in_window_1 | in_window_2) & !eligible)
   )
 }
 
@@ -1235,7 +1235,7 @@ print.bgms_prior_sensitivity = function(x, max_rows = 10L, ...) {
     ))
     if(isTRUE(x$wobble$censored > 0)) {
       cat(sprintf(
-        "         %d edge%s saturated in one of the two and %s left out of that spread.\n",
+        "         %d edge%s near the thresholds in only one of the two and %s left out of that spread.\n",
         x$wobble$censored, if(x$wobble$censored == 1L) "" else "s",
         if(x$wobble$censored == 1L) "was" else "were"
       ))

tests/testthat/test-prior-sensitivity.R

@@ -59,6 +59,31 @@ test_that("an edge saturating in one refit does not carry the yardstick to Inf",
 })
 
 
+test_that("the wobble window is symmetric in the two refits", {
+  # An edge inside the window in one refit only is counted and left out, in
+  # either order.
+  a = log(c(2, 2))
+  b = log(c(2000, 3))
+  w_ab = wobble_yardstick(a, b)
+  w_ba = wobble_yardstick(b, a)
+  expect_equal(w_ab$q95, abs(log(2) - log(3)))
+  expect_equal(w_ab$q95, w_ba$q95)
+  expect_equal(w_ab$censored, 1L)
+  expect_equal(w_ba$censored, 1L)
+
+  # Swapping the inputs changes neither the yardstick nor the count.
+  lbf_s0 = log(10) * c(0.2, -1.5, 2.9, 1.0, -12.0, 2.5)
+  lbf_rep = log(10) * c(0.3, -1.3, 2.7, 4.0, -10.7, Inf)
+  w = wobble_yardstick(lbf_s0, lbf_rep)
+  s = wobble_yardstick(lbf_rep, lbf_s0)
+  expect_equal(w$q95, stats::quantile(abs(lbf_s0 - lbf_rep)[1:3], 0.95, names = FALSE))
+  expect_equal(w$censored, 2L)
+  expect_equal(s$q95, w$q95)
+  expect_equal(s$censored, w$censored)
+  expect_equal(s$median, w$median)
+})
+
+
 test_that("vary resolves against the frame the fit used", {
   standardized = list(prior = list(
     pairwise_scale = 2, scale_rate = 0.5, scale_eta = 1

vignettes/prior-sensitivity.Rmd

@@ -124,7 +124,7 @@ between reruns of the *same* prior, with no real sensitivity present. To
 calibrate that, the check repeats one anchor refit and takes the spread of
 $|\Delta \log \mathrm{BF}|$ between the two as the empirical noise band (its
 95th percentile is the figure the report's `Noise:` line quotes, computed over
-edges whose evidence is near the decision thresholds).
+edges whose evidence is near the decision thresholds in both refits).
 
 An edge is reported as "changed, beyond run-to-run noise" only if its verdict
 changes along the curve *and* its natural log Bayes-factor swing exceeds that