commit fd9e56f36fadee3edca61961dbb558d8ce52546a
parent e5232a884dd0c98ed00f8bd6611d353d24b614d4
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 3 Jul 2026 14:39:09 -0230
Merge branch 'impl/confseq'
Numeric.Eproc.ConfSeq: anytime-valid confidence sequences for
bounded means, via the hedged-capital construction of Waudby-Smith
& Ramdas (2024), Theorem 3, over a finite grid of candidate means.
The betting scheme is pinned by the theorem rather than reusing the
library's Bettor strategies: a single m-free predictable plug-in
bet (their eq. (26)) is computed once per update from running
regularized statistics and shared across all candidates, with only
the c/m and c/(1-m) truncations (c = 1/2) candidate-specific, and
rejection decided by the max-hedge at theta = 1/2. This m-freeness
is what makes the survivor set provably an interval (m-dependent
bets like aGRAPA/ONS can produce non-interval survivor sets, their
Section E.4), which in turn makes the sentinel-widened grid
interval a sound superset of the continuum confidence sequence:
whenever 'interval' reports Just, it covers the true mean uniformly
over time with probability at least 1 - alpha. Nothing signals
resolution below the grid; rerun with a larger grid.
Rejected candidates are dropped permanently, so intervals are
nested and per-update cost is O(live candidates): ~2.1 us per
observation at g = 200, shrinking as evidence accumulates. Coverage
verified by simulation at an off-grid truth, checked after every
observation. Adds InvalidGridSize to ConfigError and the WSR paper
under etc/. Validated with and without -f+llvm.
Merge resolutions: union of the mixture- and confseq-side additions
to ConfigError, exposed-modules, the test main list, and the bench
suites.
Diffstat:
7 files changed, 514 insertions(+), 3 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -7,6 +7,7 @@ import Control.DeepSeq
import qualified Numeric.Eproc.Bernoulli as Bern
import qualified Numeric.Eproc.Bernoulli.TwoSided as BernTS
import qualified Numeric.Eproc.Bounded as Bounded
+import qualified Numeric.Eproc.ConfSeq as CS
import qualified Numeric.Eproc.Mixture as Mix
import qualified Numeric.Eproc.Paired as P
import Criterion.Main
@@ -39,6 +40,8 @@ main = defaultMain [
, bern_ts_stream
, mix_update
, mix_stream
+ , confseq_update
+ , confseq_stream
]
update :: Benchmark
@@ -162,3 +165,26 @@ mix_stream =
in bgroup "Mixture.update (1000-step fold)" [
bench "K=4" $ nf (run_x cfg) vs
]
+
+-- ConfSeq.State carries a list of live grid candidates rather than
+-- only unboxed fields, but 'initial' and 'update' construct that
+-- list fully forced, so WHNF == NF holds here by construction too.
+instance NFData CS.State where rnf !_ = ()
+
+confseq_update :: Benchmark
+confseq_update =
+ let !cfg = ok (CS.config 0.0 1.0 0.05 200)
+ !st = CS.initial cfg
+ !x = 0.7
+ in bgroup "ConfSeq.update (one step, g = 200)" [
+ bench "plug-in" $ nf (CS.update cfg st) x
+ ]
+
+confseq_stream :: Benchmark
+confseq_stream =
+ let !xs = force (take 1000 (cycle [0.3, 0.7]))
+ !cfg = ok (CS.config 0.0 1.0 0.05 200)
+ run_c = foldl' (CS.update cfg) (CS.initial cfg)
+ in bgroup "ConfSeq.update (1000-sample fold, g = 200)" [
+ bench "plug-in" $ nf run_c xs
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -7,6 +7,7 @@ import Control.DeepSeq
import qualified Numeric.Eproc.Bernoulli as Bern
import qualified Numeric.Eproc.Bernoulli.TwoSided as BernTS
import qualified Numeric.Eproc.Bounded as Bounded
+import qualified Numeric.Eproc.ConfSeq as CS
import qualified Numeric.Eproc.Mixture as Mix
import qualified Numeric.Eproc.Paired as P
import Weigh
@@ -36,6 +37,8 @@ main = mainWith $ do
bern_ts_stream
mix_update
mix_stream
+ confseq_update
+ confseq_stream
update :: Weigh ()
update =
@@ -147,3 +150,23 @@ mix_stream =
run_x c = foldl' (Mix.update c) (Mix.initial c)
in wgroup "Mixture.update (1000-step fold)" $ do
func "K=4" (run_x cfg) vs
+
+-- ConfSeq.State carries a list of live grid candidates rather than
+-- only unboxed fields, but 'initial' and 'update' construct that
+-- list fully forced, so WHNF == NF holds here by construction too.
+instance NFData CS.State where rnf !_ = ()
+
+confseq_update :: Weigh ()
+confseq_update =
+ let !cfg = ok (CS.config 0.0 1.0 0.05 200)
+ !st = CS.initial cfg
+ in wgroup "ConfSeq.update (one step, g = 200)" $ do
+ func "plug-in" (CS.update cfg st) 0.7
+
+confseq_stream :: Weigh ()
+confseq_stream =
+ let !xs = force (take 1000 (cycle [0.3, 0.7]))
+ !cfg = ok (CS.config 0.0 1.0 0.05 200)
+ run_c = foldl' (CS.update cfg) (CS.initial cfg)
+ in wgroup "ConfSeq.update (1000-sample fold, g = 200)" $ do
+ func "plug-in" run_c xs
diff --git a/etc/wsr2024.pdf b/etc/wsr2024.pdf
Binary files differ.
diff --git a/lib/Numeric/Eproc/Common.hs b/lib/Numeric/Eproc/Common.hs
@@ -113,8 +113,9 @@ data Verdict =
-- | Reasons that a test-configuration smart constructor can reject
-- its inputs. Returned by 'Numeric.Eproc.Bounded.config',
-- 'Numeric.Eproc.Bernoulli.config',
--- 'Numeric.Eproc.Paired.config', and
--- 'Numeric.Eproc.Mixture.config'.
+-- 'Numeric.Eproc.Paired.config',
+-- 'Numeric.Eproc.Mixture.config', and
+-- 'Numeric.Eproc.ConfSeq.config'.
data ConfigError =
-- | significance level outside @(0, 1)@
InvalidAlpha {-# UNPACK #-} !Double
@@ -130,6 +131,8 @@ data ConfigError =
| InvalidBaselineRate {-# UNPACK #-} !Double
-- | component count not positive
| InvalidComponentCount {-# UNPACK #-} !Int
+ -- | grid size below @1@
+ | InvalidGridSize {-# UNPACK #-} !Int
deriving (Eq, Show)
-- | True iff the argument is a finite IEEE-754 double (not NaN, not
diff --git a/lib/Numeric/Eproc/ConfSeq.hs b/lib/Numeric/Eproc/ConfSeq.hs
@@ -0,0 +1,327 @@
+{-# OPTIONS_HADDOCK prune #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- |
+-- Module: Numeric.Eproc.ConfSeq
+-- Copyright: (c) 2026 Jared Tobin
+-- License: MIT
+-- Maintainer: Jared Tobin <jared@ppad.tech>
+--
+-- Anytime-valid confidence sequence for the mean of bounded
+-- observations.
+--
+-- For samples @x_t@ in @[lo, hi]@ with common conditional mean
+--
+-- @mu = E[x_t | F_{t-1}] for all t@
+--
+-- (@F_{t-1}@ being the filtration generated by everything observed
+-- strictly before time @t@; for i.i.d. samples this is just
+-- @E[x]@), the running state yields a confidence interval @C_t@
+-- after every observation, with time-uniform coverage:
+--
+-- @P(for all t, mu in C_t) >= 1 - alpha@
+--
+-- whenever @C_t@ is reported at all (see 'interval' for the empty
+-- case). The guarantee holds uniformly over time, so the user may
+-- inspect the interval after every observation and stop at any
+-- data-dependent time -- optional stopping does not erode coverage.
+--
+-- The construction is the /hedged capital/ confidence sequence of
+-- Waudby-Smith & Ramdas (2024), Theorem 3, evaluated over a finite
+-- grid of candidate means. All arithmetic is carried out in
+-- @[0, 1]@ coordinates internally; observations are mapped affinely
+-- at the boundary. Each candidate @m@ runs a pair of betting
+-- processes: a /positive-direction/ capital @K^+_t(m)@ wagering
+-- that the mean exceeds @m@, and a /negative-direction/ capital
+-- @K^-_t(m)@ wagering the reverse. The base bet is a single
+-- predictable plug-in (their eq. (26)), computed once per update
+-- from the running regularized mean and variance of the data and
+-- shared by every candidate: it never depends on @m@, and only a
+-- final truncation to @c \/ m@ (respectively @c \/ (1 - m)@), with
+-- @c = 1\/2@, is candidate-specific. This @m@-freeness is what
+-- makes the survivor set provably an interval (Theorem 3);
+-- @m@-dependent bets can produce non-interval survivor sets (their
+-- Section E.4), which is why this module does not use the library's
+-- 'Numeric.Eproc.Common.Bettor' strategies.
+--
+-- A candidate @m@ is rejected once the max-hedge (@theta = 1\/2@)
+-- capital @max(K^+_t(m), K^-_t(m)) \/ 2@ crosses @1 \/ alpha@.
+-- Under the truth @m = mu@ each capital process is a nonnegative
+-- supermartingale, the max is dominated by the convex combination
+-- @(K^+ + K^-) \/ 2@, and Ville's inequality bounds the probability
+-- that the truth is ever rejected by @alpha@. No multiplicity
+-- correction across grid candidates is needed: coverage concerns
+-- only the true mean's own test, and rejection of other candidates
+-- merely tightens the interval.
+--
+-- Grid resolution is an accuracy\/cost knob. Interval endpoints are
+-- quantized to the grid -- a @g@-point grid resolves them to within
+-- @(hi - lo) \/ (g + 1)@ -- and per-update cost is @O(live
+-- candidates)@, shrinking as evidence accumulates and candidates
+-- are rejected.
+--
+-- == Example
+--
+-- Estimate the mean of a stream in @[0, 1]@ with empirical mean
+-- @0.8@, at level @alpha = 0.05@ on a 100-point grid:
+--
+-- >>> let Right cfg = config 0.0 1.0 0.05 100
+-- >>> let xs = concat (replicate 50 [1, 1, 0, 1, 1, 0, 1, 1, 1, 1])
+-- >>> interval cfg (foldl' (update cfg) (initial cfg) xs)
+-- Just (0.7326732673267327,0.8514851485148515)
+
+module Numeric.Eproc.ConfSeq (
+ -- * Confidence-sequence configuration and state
+ Config
+ , State
+ , ConfigError(..)
+
+ -- * Construction
+ , config
+ , initial
+
+ -- * Streaming
+ , update
+
+ -- * Inspection
+ , interval
+ , samples
+ ) where
+
+import GHC.Float (log1p)
+import Numeric.Eproc.Common (ConfigError(..), finite)
+
+-- types ----------------------------------------------------------------------
+
+-- | Confidence-sequence configuration. Build with 'config'.
+--
+-- Carries the sample bounds, the significance level, the grid
+-- size, and the precomputed per-candidate rejection threshold
+-- @log(2 \/ alpha)@ along with the bet numerator
+-- @2 log(2 \/ alpha)@.
+data Config = Config {
+ cfg_lo :: {-# UNPACK #-} !Double -- ^ sample lower bound
+ , cfg_hi :: {-# UNPACK #-} !Double -- ^ sample upper bound
+ , cfg_alpha :: {-# UNPACK #-} !Double -- ^ significance level
+ , cfg_grid :: {-# UNPACK #-} !Int -- ^ grid size @g@
+ , cfg_log_thresh :: {-# UNPACK #-} !Double -- ^ @log(2 \/ alpha)@
+ , cfg_bet_num :: {-# UNPACK #-} !Double -- ^ @2 log(2 \/ alpha)@
+ }
+
+-- | One live grid candidate: its grid index and the running
+-- log-capitals of the positive- and negative-direction bets.
+data Point = Point
+ {-# UNPACK #-} !Int -- grid index j
+ {-# UNPACK #-} !Double -- log K^+
+ {-# UNPACK #-} !Double -- log K^-
+
+-- | Streaming confidence-sequence state. Construct with 'initial'
+-- and fold observations through 'update'.
+--
+-- Carries the sample count, the shared plug-in bettor statistics
+-- (regularized running sums in @[0, 1]@ coordinates), and the
+-- live grid candidates. Rejected candidates are dropped
+-- permanently, so the reported intervals are nested.
+--
+-- Invariant: 'initial' and 'update' construct the live list fully
+-- forced -- no thunks in the spine or the elements -- so a 'State'
+-- in WHNF is already in normal form.
+data State = State {
+ st_n :: {-# UNPACK #-} !Int -- ^ sample count
+ , st_sum_y :: {-# UNPACK #-} !Double -- ^ @sum y_i@
+ , st_sum_dev2 :: {-# UNPACK #-} !Double -- ^ @sum (y_i - mu_i)^2@
+ , st_live :: ![Point] -- ^ live grid candidates
+ }
+
+-- | WSR (2024) truncation level @c = 1\/2@. Bets are capped at
+-- @c \/ m@ (positive direction) and @c \/ (1 - m)@ (negative
+-- direction), keeping every capital factor at least @1 - c > 0@.
+trunc_c :: Double
+trunc_c = 0.5
+{-# INLINE trunc_c #-}
+
+-- construction ---------------------------------------------------------------
+
+-- | Build a 'Config' for the confidence sequence.
+--
+-- The candidate means form the interior grid
+--
+-- @m_j = lo + (j \/ (g + 1)) * (hi - lo), j = 1 .. g@
+--
+-- (endpoints excluded, so that in @[0, 1]@ coordinates the bet
+-- truncations @c \/ m@ and @c \/ (1 - m)@ stay finite). The
+-- per-candidate rejection threshold @log(2 \/ alpha)@ and the bet
+-- numerator @2 log(2 \/ alpha)@ are precomputed.
+--
+-- Returns 'Left' with a 'ConfigError' on inputs that would leave
+-- the mathematical regime: @alpha@ non-finite or outside
+-- @(0, 1)@; @lo@ or @hi@ non-finite, or @lo >= hi@; or a grid
+-- size below @1@.
+--
+-- >>> let Right cfg = config 0.0 1.0 0.05 100
+config
+ :: Double -- ^ sample lower bound @lo@
+ -> Double -- ^ sample upper bound @hi@
+ -> Double -- ^ significance level @alpha@
+ -> Int -- ^ grid size @g@
+ -> Either ConfigError Config
+config !lo !hi !alpha !g
+ | not (finite alpha && alpha > 0 && alpha < 1) =
+ Left (InvalidAlpha alpha)
+ | not (finite lo && finite hi && lo < hi) =
+ Left (InvalidBounds lo hi)
+ | g < 1 =
+ Left (InvalidGridSize g)
+ | otherwise = Right Config {
+ cfg_lo = lo
+ , cfg_hi = hi
+ , cfg_alpha = alpha
+ , cfg_grid = g
+ , cfg_log_thresh = log (2 / alpha)
+ , cfg_bet_num = 2 * log (2 / alpha)
+ }
+{-# INLINE config #-}
+
+-- | The initial 'State' for a fresh confidence sequence.
+--
+-- Every grid candidate starts live with both log-capitals at @0@
+-- (i.e., @K^+ = K^- = 1@); the shared bettor statistics start
+-- from their regularized priors (@mu_0 = 1\/2@,
+-- @sigma^2_0 = 1\/4@ in @[0, 1]@ coordinates).
+--
+-- >>> let s0 = initial cfg
+initial :: Config -> State
+initial Config{..} = State {
+ st_n = 0
+ , st_sum_y = 0
+ , st_sum_dev2 = 0
+ , st_live = points 1
+ }
+ where
+ -- built eagerly: the tail is forced before consing, so the
+ -- whole list is in normal form on construction.
+ points !j
+ | j > cfg_grid = []
+ | otherwise =
+ let !p = Point j 0 0
+ !rest = points (j + 1)
+ in p : rest
+{-# INLINE initial #-}
+
+-- streaming ------------------------------------------------------------------
+
+-- | Fold one observation into the running 'State'.
+--
+-- Maps the observation to @[0, 1]@ coordinates via
+-- @y = (x - lo) \/ (hi - lo)@ and computes the shared predictable
+-- plug-in bet from the statistics accumulated through the
+-- /previous/ step (Waudby-Smith & Ramdas (2024), eq. (26)):
+--
+-- @lambda_t = min c (sqrt (2 log(2 \/ alpha)
+-- \/ (sigma^2_{t-1} * t * log(1 + t))))@
+--
+-- with @c = 1\/2@. The bet is computed once and shared across all
+-- live candidates -- its independence from @m@ is what keeps the
+-- survivor set an interval. Each live candidate @m@ then updates
+-- its pair of log-capitals with the truncated bets
+-- @min lambda_t (c \/ m)@ and @min lambda_t (c \/ (1 - m))@, and
+-- is dropped iff @max(log K^+, log K^-)@ has reached
+-- @log(2 \/ alpha)@. Finally @y@ is folded into the shared
+-- statistics, preserving predictability of the next bet.
+--
+-- /Precondition/: @x@ must lie in the @[lo, hi]@ interval given
+-- to 'config'. The coverage guarantee of the sequence depends on
+-- it. Out-of-range observations can drive a capital factor
+-- negative, taking the construction out of the supermartingale
+-- regime entirely; the function does not check for this.
+--
+-- >>> let s1 = update cfg s0 0.7
+update :: Config -> State -> Double -> State
+update Config{..} State{..} !x =
+ let !y = (x - cfg_lo) / (cfg_hi - cfg_lo)
+ !t = st_n + 1
+ !td = fromIntegral t
+ !gp1 = fromIntegral (cfg_grid + 1)
+ -- sigma^2_{t-1} = (1/4 + sum_{i<=t-1} (y_i - mu_i)^2) / t
+ !sig2 = (0.25 + st_sum_dev2) / td
+ !lam = min trunc_c
+ (sqrt (cfg_bet_num / (sig2 * td * log1p td)))
+ -- built eagerly, as in 'initial': the tail is forced before
+ -- consing, so the new live list is in normal form on
+ -- construction.
+ go [] = []
+ go (Point j lp ln : ps) =
+ let !m = fromIntegral j / gp1
+ !d = y - m
+ !lp' = lp + log1p (min lam (trunc_c / m) * d)
+ !ln' = ln + log1p (negate (min lam (trunc_c / (1 - m)))
+ * d)
+ !rest = go ps
+ in if max lp' ln' >= cfg_log_thresh
+ then rest
+ else Point j lp' ln' : rest
+ !live = go st_live
+ -- fold y into the shared statistics only now: the bet above
+ -- used statistics through t-1, so predictability holds. the
+ -- deviation at step t uses the current-inclusive mean mu_t.
+ !sum_y' = st_sum_y + y
+ !mu = (0.5 + sum_y') / (td + 1)
+ !dev = y - mu
+ !dev2' = st_sum_dev2 + dev * dev
+ in State t sum_y' dev2' live
+{-# INLINE update #-}
+
+-- inspection -----------------------------------------------------------------
+
+-- | The current confidence interval, in the original @[lo, hi]@
+-- coordinates.
+--
+-- The interval spans the surviving grid candidates, widened by
+-- one grid step at each end (or clamped to @lo@ \/ @hi@ at the
+-- grid's edges). The widening is what makes off-grid true means
+-- safe: Theorem 3 guarantees the ideal continuum survivor set is
+-- an interval, so its endpoints are bracketed by the nearest
+-- /rejected/ grid candidates, and reporting those sentinels
+-- yields a superset of the continuum interval. Whenever the
+-- result is 'Just', it therefore covers the true mean uniformly
+-- over time with probability at least @1 - alpha@ -- no
+-- multiplicity correction across candidates is needed, since
+-- coverage concerns only the true mean's own test.
+--
+-- 'Nothing' means every grid candidate has been rejected: the
+-- evidence has resolved the mean below the grid's resolution.
+-- For a true mean lying exactly on the grid this has probability
+-- at most @alpha@ (its own test must have rejected). For an
+-- off-grid true mean it additionally occurs once the continuum
+-- survivor interval shrinks inside a single grid cell -- a
+-- quantization horizon far beyond the point where the reported
+-- width is comparable to the grid spacing. Treat 'Nothing' as a
+-- signal to rerun with a larger grid, not as an inference.
+--
+-- >>> interval cfg (initial cfg)
+-- Just (0.0,1.0)
+interval :: Config -> State -> Maybe (Double, Double)
+interval Config{..} State{..} = case st_live of
+ [] -> Nothing
+ (Point j0 _ _ : ps) ->
+ let !jmin = foldl' (\acc (Point j _ _) -> min acc j) j0 ps
+ !jmax = foldl' (\acc (Point j _ _) -> max acc j) j0 ps
+ !gp1 = fromIntegral (cfg_grid + 1)
+ !w = cfg_hi - cfg_lo
+ !l | jmin == 1 = cfg_lo
+ | otherwise =
+ cfg_lo + fromIntegral (jmin - 1) / gp1 * w
+ !u | jmax == cfg_grid = cfg_hi
+ | otherwise =
+ cfg_lo + fromIntegral (jmax + 1) / gp1 * w
+ in Just (l, u)
+{-# INLINE interval #-}
+
+-- | The number of samples consumed so far.
+--
+-- >>> samples s0
+-- 0
+samples :: State -> Int
+samples = st_n
+{-# INLINE samples #-}
diff --git a/ppad-eproc.cabal b/ppad-eproc.cabal
@@ -38,6 +38,7 @@ library
Numeric.Eproc.Bernoulli.TwoSided
Numeric.Eproc.Bounded
Numeric.Eproc.Common
+ Numeric.Eproc.ConfSeq
Numeric.Eproc.Mixture
Numeric.Eproc.Paired
build-depends:
diff --git a/test/Main.hs b/test/Main.hs
@@ -8,6 +8,7 @@ import qualified Numeric.Eproc.Bernoulli as Bern
import qualified Numeric.Eproc.Bernoulli.TwoSided as BernTS
import qualified Numeric.Eproc.Bounded as Bounded
import qualified Numeric.Eproc.Common as C
+import qualified Numeric.Eproc.ConfSeq as CS
import qualified Numeric.Eproc.Mixture as Mix
import qualified Numeric.Eproc.Paired as P
import Test.Tasty
@@ -28,6 +29,7 @@ main = defaultMain $ testGroup "ppad-eproc" [
, two_sided_bernoulli_tests
, evalue_accessor_tests
, mixture_tests
+ , confseq_tests
]
-- partial helper: tests below hardcode valid configs.
@@ -628,7 +630,6 @@ safety_property_tests = testGroup "safety properties" [
in monotone_reject_bern_ts vs
]
--- e-value accessors ----------------------------------------------------------
unit_pair :: QC.Gen (Double, Double)
unit_pair = (,) <$> unit_double <*> unit_double
@@ -864,3 +865,133 @@ mixture_tests = testGroup "mixture" [
assertBool ("power " ++ show rate ++ " too low") $
rate >= 0.95
]
+-- confidence sequences -------------------------------------------------------
+-- a finite stream of bernoulli(p) samples.
+cs_stream :: Double -> Int -> Gen -> [Double]
+cs_stream !p n g0 = go n g0
+ where
+ go 0 _ = []
+ go !k !g =
+ let (x, g') = bernoulli p g
+ in x : go (k - 1) g'
+
+-- do the intervals nest: each contained in its predecessor, with
+-- Nothing (empty) absorbing?
+cs_nested :: [Maybe (Double, Double)] -> Bool
+cs_nested ivs = and (zipWith shrink ivs (drop 1 ivs))
+ where
+ shrink (Just (l1, u1)) (Just (l2, u2)) = l2 >= l1 && u2 <= u1
+ shrink (Just _) Nothing = True
+ shrink Nothing Nothing = True
+ shrink Nothing (Just _) = False
+
+-- fraction of trials in which the true mean ever escapes the running
+-- interval (or the interval goes empty), checked after every
+-- observation.
+cs_miscoverage_rate
+ :: CS.Config
+ -> Double -- ^ true mean
+ -> Int -- ^ budget per trial
+ -> Int -- ^ number of trials
+ -> Word64 -- ^ seed
+ -> Double
+cs_miscoverage_rate cfg p budget trials seed =
+ let gens = take trials (gen_seq (mk_gen seed))
+ misses = length [ () | g <- gens, cs_trial_missed g ]
+ in fromIntegral misses / fromIntegral trials
+ where
+ cs_trial_missed g0 = go budget g0 (CS.initial cfg)
+ where
+ go !k !g !st
+ | k == 0 = False
+ | otherwise =
+ let (x, g') = bernoulli p g
+ st' = CS.update cfg st x
+ in case CS.interval cfg st' of
+ Nothing -> True
+ Just (l, u)
+ | p < l || p > u -> True
+ | otherwise -> go (k - 1) g' st'
+
+confseq_tests :: TestTree
+confseq_tests = testGroup "confidence sequences" [
+ testCase "initial interval is the full range" $ do
+ let cfg = ok (CS.config 0.0 1.0 0.05 100)
+ CS.interval cfg (CS.initial cfg) @?= Just (0.0, 1.0)
+ , testCase "intervals nest along a deterministic stream" $ do
+ let cfg = ok (CS.config 0.0 1.0 0.05 50)
+ xs = take 500 (cycle [1.0, 1.0, 0.0, 1.0])
+ sts = scanl (CS.update cfg) (CS.initial cfg) xs
+ ivs = map (CS.interval cfg) sts
+ assertBool "nesting violated" (cs_nested ivs)
+ -- the stream has empirical mean 0.75; the final interval must
+ -- be a strict refinement of the initial one.
+ case (ivs, reverse ivs) of
+ (iv0 : _, ivn : _) -> assertBool "no shrinkage" (iv0 /= ivn)
+ _ -> assertFailure "no intervals"
+ , QC.testProperty "intervals nest along any admissible stream" $
+ QC.forAll (QC.listOf unit_double) $ \xs ->
+ let cfg = ok (CS.config 0.0 1.0 0.05 25)
+ sts = scanl (CS.update cfg) (CS.initial cfg) xs
+ in cs_nested (map (CS.interval cfg) sts)
+ , testCase "coverage: off-grid Bernoulli(0.437) at alpha = 0.05" $ do
+ let cfg = ok (CS.config 0.0 1.0 0.05 100)
+ rate = cs_miscoverage_rate cfg 0.437 1500 200 991199
+ -- expected miscoverage <= 0.05; allow up to 0.08 slack for
+ -- sampling variability over 200 trials.
+ assertBool ("miscoverage " ++ show rate ++ " exceeded slack") $
+ rate <= 0.08
+ , testCase "consistency: Bernoulli(0.3) interval shrinks onto mean" $ do
+ let cfg = ok (CS.config 0.0 1.0 1.0e-3 200)
+ xs = cs_stream 0.3 5000 (mk_gen 424242)
+ st = foldl' (CS.update cfg) (CS.initial cfg) xs
+ case CS.interval cfg st of
+ Nothing -> assertFailure "interval empty"
+ Just (l, u) -> do
+ assertBool ("interval " ++ show (l, u) ++ " misses mean") $
+ l <= 0.3 && 0.3 <= u
+ assertBool ("width " ++ show (u - l) ++ " too wide") $
+ u - l < 0.2
+ , testCase "affine: mean recovered on [-5, 5]" $ do
+ -- x = 4 w.p. 0.7, x = -4 w.p. 0.3: true mean 1.6, interior
+ -- to the sample bounds and asymmetric about zero.
+ let cfg = ok (CS.config (-5.0) 5.0 0.05 100)
+ xs = [ if b == 1.0 then 4.0 else (-4.0)
+ | b <- cs_stream 0.7 3000 (mk_gen 232323) ]
+ st = foldl' (CS.update cfg) (CS.initial cfg) xs
+ case CS.interval cfg st of
+ Nothing -> assertFailure "interval empty"
+ Just (l, u) -> do
+ assertBool ("interval " ++ show (l, u) ++ " misses mean") $
+ l <= 1.6 && 1.6 <= u
+ assertBool ("interval " ++ show (l, u) ++ " not refined") $
+ l > -5.0 && u < 5.0
+ , testCase "config: grid size 0 rejected" $
+ assertLeftCS (CS.config 0.0 1.0 0.05 0)
+ , testCase "config: negative grid size rejected" $
+ assertLeftCS (CS.config 0.0 1.0 0.05 (-3))
+ , testCase "config: alpha out of range rejected" $ do
+ assertLeftCS (CS.config 0.0 1.0 0.0 100)
+ assertLeftCS (CS.config 0.0 1.0 1.5 100)
+ , testCase "config: lo >= hi rejected" $
+ assertLeftCS (CS.config 1.0 0.0 0.05 100)
+ , testCase "config: non-finite inputs rejected" $ do
+ let nan = 0 / 0 :: Double
+ pInf = 1 / 0 :: Double
+ assertLeftCS (CS.config nan 1.0 0.05 100)
+ assertLeftCS (CS.config 0.0 pInf 0.05 100)
+ assertLeftCS (CS.config 0.0 1.0 nan 100)
+ , QC.testProperty "interval endpoints well-formed on any stream" $
+ QC.forAll (QC.listOf unit_double) $ \xs ->
+ let cfg = ok (CS.config 0.0 1.0 0.05 25)
+ st = foldl' (CS.update cfg) (CS.initial cfg) xs
+ in case CS.interval cfg st of
+ Nothing -> True
+ Just (l, u) ->
+ finite l && finite u && 0 <= l && l <= u && u <= 1
+ ]
+ where
+ assertLeftCS :: Either C.ConfigError a -> Assertion
+ assertLeftCS e = case e of
+ Left _ -> pure ()
+ Right _ -> assertFailure "expected Left"
