commit 1998344fea37369058a401bec35870a1347043de
parent c35e2ca28eb847b2b556c5bc017723d88dc426bc
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 2 Jul 2026 16:41:25 -0230
Bernoulli.TwoSided: newtype-wrap Bounded
The two-sided Bernoulli rate test at p_0 is exactly the
two-sided bounded-mean test on [0, 1] with m = p_0: same
safe-bet ceilings (0.5/p_0 and 0.5/(1-p_0)), same convex-hedge
construction, same log(2/alpha) threshold, same latched-max
statistic. The prior implementation had all this machinery
duplicated verbatim from Bounded, including the log_sum_exp
fast-path skip that would otherwise need to be maintained in
lockstep across two modules.
Refactor along the same lines as Numeric.Eproc.Paired: newtype
Config = Config Bounded.Config, newtype State = State
Bounded.State, and each operation delegates. update maps the
Bool observation to its numeric encoding and forwards. 'config'
still emits InvalidBaselineRate for p_0 out of (0, 1) — that's
the meaningful error for a Bernoulli-facing caller, not the
Bounded-flavoured InvalidNullMean.
122 lines deleted, 31 added. INLINE pragmas make the wrapping
transparent; the criterion fold numbers are unchanged or
marginally better (14.84 us vs 15.65 us for the newton case).
All 59 tests still pass.
Diffstat:
1 file changed, 31 insertions(+), 122 deletions(-)
diff --git a/lib/Numeric/Eproc/Bernoulli/TwoSided.hs b/lib/Numeric/Eproc/Bernoulli/TwoSided.hs
@@ -1,6 +1,5 @@
{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE RecordWildCards #-}
-- |
-- Module: Numeric.Eproc.Bernoulli.TwoSided
@@ -17,20 +16,13 @@
-- against the negation. The canonical case is the sign test at
-- @p_0 = 1\/2@.
--
--- The construction is the convex hedge of Waudby-Smith & Ramdas
--- (2024) §4: two per-direction Bernoulli capital processes
--- @K^+_t@ (betting against @p > p_0@ via @z = x - p_0@) and
--- @K^-_t@ (betting against @p < p_0@ via @-z@) are combined into
--- the hedged e-process @K_t = (K^+_t + K^-_t) \/ 2@ with
--- @E[K_0] = 1@. By Ville's inequality
--- @P(sup_t K_t >= 1 \/ alpha) <= alpha@, so the test rejects when
--- the supremum of @K^+_t + K^-_t@ has ever crossed @2 \/ alpha@;
--- the threshold is @log(2 \/ alpha)@. This is the same construction
--- "Numeric.Eproc.Bounded" uses to combine its two directional
--- processes.
---
--- The test is /anytime-valid/ and rejection is /latched/ in the
--- running state.
+-- This is exactly the two-sided bounded-mean test on @[0, 1]@ with
+-- null mean @p_0@, so the module is a thin newtype wrapper over
+-- "Numeric.Eproc.Bounded" (much as "Numeric.Eproc.Paired" is a
+-- wrapper for the paired difference case). See the Bounded module
+-- for the mathematical detail: convex-hedge combination of two
+-- per-direction e-processes, threshold @log(2 \/ alpha)@, latched
+-- rejection, etc.
--
-- == Example
--
@@ -65,61 +57,27 @@ module Numeric.Eproc.Bernoulli.TwoSided (
, samples
) where
-import GHC.Float (log1p)
-import Numeric.Eproc.Common (
- Bettor(..), Verdict(..), ConfigError(..)
- , BetState, init_bet, bet_lambda, step_bet
- , finite, log_sum_exp, log2_dbl
- )
+import qualified Numeric.Eproc.Bounded as Bounded
+import Numeric.Eproc.Common (Bettor(..), Verdict(..), ConfigError(..))
-- types ----------------------------------------------------------------------
-- | Two-sided Bernoulli rate test configuration. Build with 'config'.
---
--- Carries the bettor strategy, the baseline rate, the significance
--- level, the precomputed convex-hedge log-wealth threshold
--- @log(2 \/ alpha)@, and the per-direction safe-bet ceilings.
-data Config = Config {
- cfg_bettor :: !Bettor
- , cfg_lam_max_pos :: {-# UNPACK #-} !Double -- 0.5 / p0
- , cfg_lam_max_neg :: {-# UNPACK #-} !Double -- 0.5 / (1 - p0)
- , cfg_p0 :: {-# UNPACK #-} !Double
- , cfg_alpha :: {-# UNPACK #-} !Double
- , cfg_log_thresh :: {-# UNPACK #-} !Double -- log(2/alpha)
- }
+-- Wraps a 'Numeric.Eproc.Bounded.Config' on @[0, 1]@ with null
+-- mean @p_0@.
+newtype Config = Config Bounded.Config
-- | Streaming test state. Construct with 'initial' and fold
-- observations through 'update'.
---
--- The two log-wealth fields track the running log-wealth of the
--- positive- and negative-direction Bernoulli e-processes
--- separately; the /max log-sum/ field latches the supremum so
--- far of @log(K^+_t + K^-_t)@, which is the statistic the
--- convex-hedge construction actually monitors.
-data State = State {
- st_n :: {-# UNPACK #-} !Int
- , st_log_w_pos :: {-# UNPACK #-} !Double
- , st_log_w_neg :: {-# UNPACK #-} !Double
- , st_max_log_sum :: {-# UNPACK #-} !Double
- , st_bet_pos :: !BetState
- , st_bet_neg :: !BetState
- }
+newtype State = State Bounded.State
-- construction ---------------------------------------------------------------
-- | Build a 'Config' for the two-sided Bernoulli rate test.
--
--- Per-direction safe-bet ceilings are @0.5 \/ p_0@ (positive) and
--- @0.5 \/ (1 - p_0)@ (negative), chosen so that each wealth factor
--- stays nonnegative for both admissible observations. The
--- threshold is @log(2 \/ alpha)@; the 2 reflects that the
--- convex-hedge test monitors the sum @K^+ + K^-@, whose initial
--- value is @2@ (each side starts at @K = 1@).
---
-- Returns 'Left' with a 'ConfigError' on inputs that would leave
--- the mathematical regime: either of @p_0@ or @alpha@ non-finite
--- (NaN or infinite); @p_0@ outside @(0, 1)@; or @alpha@ outside
--- @(0, 1)@.
+-- the mathematical regime: @p_0@ outside @(0, 1)@ (or non-finite),
+-- or @alpha@ outside @(0, 1)@ (or non-finite).
--
-- >>> let Right cfg = config 0.5 1.0e-3 Newton
config
@@ -127,98 +85,49 @@ config
-> Double -- ^ significance level @alpha@, in @(0, 1)@
-> Bettor -- ^ bettor strategy
-> Either ConfigError Config
-config !p0 !alpha !b
- | not (finite p0 && p0 > 0 && p0 < 1) =
- Left (InvalidBaselineRate p0)
- | not (finite alpha && alpha > 0 && alpha < 1) =
- Left (InvalidAlpha alpha)
- | otherwise = Right Config {
- cfg_bettor = b
- , cfg_lam_max_pos = 0.5 / p0
- , cfg_lam_max_neg = 0.5 / (1 - p0)
- , cfg_p0 = p0
- , cfg_alpha = alpha
- , cfg_log_thresh = log (2 / alpha)
- }
+config !p0 !alpha b
+ -- NaN comparisons return False and (-Inf, +Inf) fail the range
+ -- check, so this catches non-finite p_0 without a separate guard.
+ | not (p0 > 0 && p0 < 1) = Left (InvalidBaselineRate p0)
+ | otherwise = fmap Config (Bounded.config p0 0 1 alpha b)
{-# INLINE config #-}
-- | The initial 'State' for a fresh streaming test.
--
--- Both per-direction log-wealths start at @0@ (i.e., @K = 1@);
--- the max-log-sum starts at @log 2@ (since @K^+_0 + K^-_0 = 2@);
--- both bettors start in the per-strategy initial state
--- appropriate for the 'Bettor' chosen in the 'Config'.
---
-- >>> let s0 = initial cfg
initial :: Config -> State
-initial Config{..} =
- let !s0 = init_bet cfg_bettor
- in State {
- st_n = 0
- , st_log_w_pos = 0
- , st_log_w_neg = 0
- , st_max_log_sum = log2_dbl
- , st_bet_pos = s0
- , st_bet_neg = s0
- }
+initial (Config c) = State (Bounded.initial c)
{-# INLINE initial #-}
-- streaming ------------------------------------------------------------------
--- | Fold one observation into the running 'State'.
---
--- Computes the centred observation @z = x - p_0@, queries the two
--- directional bettors, accumulates per-direction log-wealth, then
--- updates the running supremum of @log(K^+ + K^-)@ via
--- log-sum-exp and steps the bettor states.
+-- | Fold one observation into the running 'State'. Equivalent to
+-- feeding the numeric @1@\/@0@ encoding of the observation into
+-- the underlying bounded-mean test.
--
-- >>> let s1 = update cfg s0 True
update :: Config -> State -> Bool -> State
-update Config{..} State{..} !x =
- let !xd = if x then 1 else 0
- !z = xd - cfg_p0
- !lam_p = bet_lambda cfg_bettor cfg_lam_max_pos st_bet_pos
- !lam_n = bet_lambda cfg_bettor cfg_lam_max_neg st_bet_neg
- !logw_p = st_log_w_pos + log1p (lam_p * z)
- !logw_n = st_log_w_neg + log1p (negate lam_n * z)
- -- see the twin comment in 'Numeric.Eproc.Bounded.update' for
- -- why we can skip 'log_sum_exp' via a cheap upper bound.
- !cheap_ub = max logw_p logw_n + log2_dbl
- !max_sum
- | cheap_ub <= st_max_log_sum = st_max_log_sum
- | otherwise =
- max st_max_log_sum (log_sum_exp logw_p logw_n)
- !sp = step_bet cfg_bettor cfg_lam_max_pos st_bet_pos z
- !sn = step_bet cfg_bettor cfg_lam_max_neg st_bet_neg (negate z)
- in State (st_n + 1) logw_p logw_n max_sum sp sn
+update (Config c) (State s) !x =
+ State (Bounded.update c s (if x then 1 else 0))
{-# INLINE update #-}
-- | Compute the current 'Verdict' from the running 'State'.
--
--- 'Reject' iff the supremum-so-far of @log(K^+_t + K^-_t)@ has
--- crossed @log(2 \/ alpha)@ at some point; equivalently the
--- convex-hedge e-process @(K^+ + K^-) \/ 2@ has exceeded
--- @1 \/ alpha@. Under @H_0@, Ville's inequality bounds the
--- probability of this ever happening by @alpha@, uniformly
--- across sample counts.
---
-- >>> decide cfg s0
-- Continue
decide :: Config -> State -> Verdict
-decide Config{..} State{..}
- | st_max_log_sum >= cfg_log_thresh = Reject
- | otherwise = Continue
+decide (Config c) (State s) = Bounded.decide c s
{-# INLINE decide #-}
-- inspection -----------------------------------------------------------------
--- | The supremum-so-far of @log(K^+_t + K^-_t)@. Monotone
--- nondecreasing; starts at @log 2@ (since @K^+_0 + K^-_0 = 2@).
+-- | The supremum-so-far of @log(K^+_t + K^-_t)@ from the underlying
+-- bounded-mean test. Starts at @log 2@.
--
-- >>> log_wealth s0
-- 0.6931471805599453
log_wealth :: State -> Double
-log_wealth = st_max_log_sum
+log_wealth (State s) = Bounded.log_wealth s
{-# INLINE log_wealth #-}
-- | The number of samples consumed so far.
@@ -226,5 +135,5 @@ log_wealth = st_max_log_sum
-- >>> samples s0
-- 0
samples :: State -> Int
-samples = st_n
+samples (State s) = Bounded.samples s
{-# INLINE samples #-}
