commit 709017518315c6d80df87492e7300e86abdb7a5e
parent 05542c668916429b9dd6b0ddafe42c88da145ffb
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 2 Jul 2026 17:23:55 -0230
Merge branch 'impl/log-wealth-sup'
Splits the log-wealth accessor, uniformly across Bounded, Paired,
Bernoulli, and Bernoulli.TwoSided: log_wealth now returns the
current log-wealth, and the latched supremum-so-far statistic
that 'decide' monitors is exposed separately as log_wealth_sup.
Internal state fields are renamed to match (st_sup_log_sum,
st_sup_log_w); the stale Paired 'log_wealth s0' Haddock example
(0.0 -> log 2) is fixed; property tests now target log_wealth_sup
for monotonicity, cover both accessors for finiteness, and check
that log_wealth is bounded above by log_wealth_sup pointwise;
README and CHANGELOG updated.
Breaking: callers that relied on log_wealth returning the
supremum should switch to log_wealth_sup.
Diffstat:
8 files changed, 130 insertions(+), 40 deletions(-)
diff --git a/CHANGELOG b/CHANGELOG
@@ -1,5 +1,14 @@
# Changelog
+- unreleased
+ * 'log_wealth' now returns the current log-wealth, and the
+ supremum-so-far statistic that 'decide' monitors is exposed
+ separately as 'log_wealth_sup'. Applies uniformly across
+ 'Bounded', 'Paired', 'Bernoulli', and 'Bernoulli.TwoSided'.
+
+ Breaking: callers that relied on 'log_wealth' returning the
+ supremum should switch to 'log_wealth_sup'.
+
- 0.2.2 (2026-07-02)
* Adds a Numeric.Eproc.Bernoulli.TwoSided module for a two-sided
Bernoulli rate test.
diff --git a/README.md b/README.md
@@ -25,16 +25,18 @@ A sample GHCi session:
> let xs = [1, 1, 0, 1, 1, 0, 1, 1, 1, 1]
> let s10 = foldl' (Bounded.update cfg) s0 xs
>
- > -- inspect (supremum-so-far) log-wealth and stopping decision at any
- > -- point
+ > -- inspect current and supremum-so-far log-wealth, and the stopping
+ > -- decision, at any point
> Bounded.log_wealth s10
+ 0.6187772969384595
+ > Bounded.log_wealth_sup s10
0.916290731874155
> Bounded.decide cfg s10
Continue
>
> -- with enough evidence, the hypothesis is rejected
> let s300 = foldl' (Bounded.update cfg) s0 (concat (replicate 30 xs))
- > Bounded.log_wealth s300
+ > Bounded.log_wealth_sup s300
51.14271142862292
> Bounded.decide cfg s300
Reject
diff --git a/lib/Numeric/Eproc/Bernoulli.hs b/lib/Numeric/Eproc/Bernoulli.hs
@@ -72,6 +72,7 @@ module Numeric.Eproc.Bernoulli (
-- * Inspection
, log_wealth
+ , log_wealth_sup
, samples
) where
@@ -117,7 +118,7 @@ data Config = Config {
data State = State {
st_n :: {-# UNPACK #-} !Int -- ^ sample count
, st_log_w :: {-# UNPACK #-} !Double -- ^ running log-wealth
- , st_max_log_w :: {-# UNPACK #-} !Double -- ^ sup log-wealth so far
+ , st_sup_log_w :: {-# UNPACK #-} !Double -- ^ sup log-wealth so far
, st_bet :: !BetState -- ^ bettor state
}
@@ -169,7 +170,7 @@ initial :: Config -> State
initial Config{..} = State {
st_n = 0
, st_log_w = 0
- , st_max_log_w = 0
+ , st_sup_log_w = 0
, st_bet = init_bet cfg_bettor
}
{-# INLINE initial #-}
@@ -202,9 +203,9 @@ update Config{..} State{..} !x =
!z = xd - cfg_p0
!lam = bet_lambda cfg_bettor cfg_lam_max st_bet
!logw' = st_log_w + log1p (lam * z)
- !maxw' = max st_max_log_w logw'
+ !supw' = max st_sup_log_w logw'
!s' = step_bet cfg_bettor cfg_lam_max st_bet z
- in State (st_n + 1) logw' maxw' s'
+ in State (st_n + 1) logw' supw' s'
{-# INLINE update #-}
-- | Compute the current 'Verdict' from the running 'State'.
@@ -221,12 +222,26 @@ update Config{..} State{..} !x =
-- Continue
decide :: Config -> State -> Verdict
decide Config{..} State{..}
- | st_max_log_w >= cfg_log_thresh = Reject
+ | st_sup_log_w >= cfg_log_thresh = Reject
| otherwise = Continue
{-# INLINE decide #-}
-- inspection -----------------------------------------------------------------
+-- | The current running log-wealth @log W_n@ at the present sample
+-- count.
+--
+-- Unlike 'log_wealth_sup' this is not monotone: adverse
+-- observations decrease it. It is bounded above by
+-- 'log_wealth_sup', which is what 'decide' tests against the
+-- rejection threshold.
+--
+-- >>> log_wealth s0
+-- 0.0
+log_wealth :: State -> Double
+log_wealth = st_log_w
+{-# INLINE log_wealth #-}
+
-- | The supremum-so-far log-wealth, across all sample counts up to
-- the current one.
--
@@ -234,11 +249,11 @@ decide Config{..} State{..}
-- nondecreasing in the sample count, and 'decide' rejects exactly
-- when it crosses @log(1 \/ alpha)@.
--
--- >>> log_wealth s0
+-- >>> log_wealth_sup s0
-- 0.0
-log_wealth :: State -> Double
-log_wealth = st_max_log_w
-{-# INLINE log_wealth #-}
+log_wealth_sup :: State -> Double
+log_wealth_sup = st_sup_log_w
+{-# INLINE log_wealth_sup #-}
-- | The number of samples consumed so far.
--
diff --git a/lib/Numeric/Eproc/Bernoulli/TwoSided.hs b/lib/Numeric/Eproc/Bernoulli/TwoSided.hs
@@ -54,6 +54,7 @@ module Numeric.Eproc.Bernoulli.TwoSided (
-- * Inspection
, log_wealth
+ , log_wealth_sup
, samples
) where
@@ -121,8 +122,9 @@ decide (Config c) (State s) = Bounded.decide c s
-- inspection -----------------------------------------------------------------
--- | The supremum-so-far of @log(K^+_t + K^-_t)@ from the underlying
--- bounded-mean test. Starts at @log 2@.
+-- | The current @log(K^+_t + K^-_t)@ of the underlying bounded-mean
+-- test. Not monotone; bounded above by 'log_wealth_sup'. Starts
+-- at @log 2@.
--
-- >>> log_wealth s0
-- 0.6931471805599453
@@ -130,6 +132,16 @@ log_wealth :: State -> Double
log_wealth (State s) = Bounded.log_wealth s
{-# INLINE log_wealth #-}
+-- | The supremum-so-far of @log(K^+_t + K^-_t)@ from the underlying
+-- bounded-mean test. Monotone nondecreasing; 'decide' rejects
+-- exactly when it crosses @log(2 \/ alpha)@. Starts at @log 2@.
+--
+-- >>> log_wealth_sup s0
+-- 0.6931471805599453
+log_wealth_sup :: State -> Double
+log_wealth_sup (State s) = Bounded.log_wealth_sup s
+{-# INLINE log_wealth_sup #-}
+
-- | The number of samples consumed so far.
--
-- >>> samples s0
diff --git a/lib/Numeric/Eproc/Bounded.hs b/lib/Numeric/Eproc/Bounded.hs
@@ -83,6 +83,7 @@ module Numeric.Eproc.Bounded (
-- * Inspection
, log_wealth
+ , log_wealth_sup
, samples
) where
@@ -126,7 +127,7 @@ data Config = Config {
--
-- The two log-wealth fields track the running log-wealth of the
-- positive- and negative-direction e-processes separately; the
--- /max log-sum/ field latches the supremum so far of
+-- /sup log-sum/ field latches the supremum so far of
-- @log(K^+_t + K^-_t)@, which is the test statistic the
-- convex-hedge construction actually monitors. The per-direction
-- bettor states carry whatever the chosen 'Bettor' needs (running
@@ -135,7 +136,7 @@ data State = State {
st_n :: {-# UNPACK #-} !Int -- ^ sample count
, st_log_w_pos :: {-# UNPACK #-} !Double -- ^ log-wealth, pos
, st_log_w_neg :: {-# UNPACK #-} !Double -- ^ log-wealth, neg
- , st_max_log_sum :: {-# UNPACK #-} !Double -- ^ sup log(K^+ + K^-)
+ , st_sup_log_sum :: {-# UNPACK #-} !Double -- ^ sup log(K^+ + K^-)
, st_bet_pos :: !BetState -- ^ bettor state, pos
, st_bet_neg :: !BetState -- ^ bettor state, neg
}
@@ -198,7 +199,7 @@ config !m !lo !hi !alpha !b
-- | 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@);
+-- the sup-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'.
--
@@ -210,7 +211,7 @@ initial Config{..} =
st_n = 0
, st_log_w_pos = 0
, st_log_w_neg = 0
- , st_max_log_sum = log2_dbl
+ , st_sup_log_sum = log2_dbl
, st_bet_pos = s0
, st_bet_neg = s0
}
@@ -250,13 +251,13 @@ update Config{..} State{..} !x =
-- already sits at or below the running max: no update can
-- move it. Under H_0 (calibration) this is the common case.
!cheap_ub = max logw_p logw_n + log2_dbl
- !max_sum
- | cheap_ub <= st_max_log_sum = st_max_log_sum
+ !sup_sum
+ | cheap_ub <= st_sup_log_sum = st_sup_log_sum
| otherwise =
- max st_max_log_sum (log_sum_exp logw_p logw_n)
+ max st_sup_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
+ in State (st_n + 1) logw_p logw_n sup_sum sp sn
{-# INLINE update #-}
-- | Compute the current 'Verdict' from the running 'State'.
@@ -274,12 +275,28 @@ update Config{..} State{..} !x =
-- Continue
decide :: Config -> State -> Verdict
decide Config{..} State{..}
- | st_max_log_sum >= cfg_log_thresh = Reject
+ | st_sup_log_sum >= cfg_log_thresh = Reject
| otherwise = Continue
{-# INLINE decide #-}
-- inspection -----------------------------------------------------------------
+-- | The current @log(K^+_t + K^-_t)@ -- the running log-wealth of
+-- the convex-hedge combination at the present sample count.
+--
+-- Unlike 'log_wealth_sup' this is not monotone: adverse
+-- observations decrease it. It is bounded above by
+-- 'log_wealth_sup', which is what 'decide' tests against the
+-- rejection threshold.
+--
+-- Starts at @log 2@ (since @K^+_0 + K^-_0 = 2@).
+--
+-- >>> log_wealth s0
+-- 0.6931471805599453
+log_wealth :: State -> Double
+log_wealth State{..} = log_sum_exp st_log_w_pos st_log_w_neg
+{-# INLINE log_wealth #-}
+
-- | The supremum-so-far of @log(K^+_t + K^-_t)@, taken across all
-- sample counts up to the current one. This is the test statistic
-- the convex-hedge construction actually monitors: it is monotone
@@ -288,11 +305,11 @@ decide Config{..} State{..}
--
-- Starts at @log 2@ (since @K^+_0 + K^-_0 = 2@).
--
--- >>> log_wealth s0
+-- >>> log_wealth_sup s0
-- 0.6931471805599453
-log_wealth :: State -> Double
-log_wealth State{..} = st_max_log_sum
-{-# INLINE log_wealth #-}
+log_wealth_sup :: State -> Double
+log_wealth_sup State{..} = st_sup_log_sum
+{-# INLINE log_wealth_sup #-}
-- | The number of samples consumed so far.
--
diff --git a/lib/Numeric/Eproc/Common.hs b/lib/Numeric/Eproc/Common.hs
@@ -132,7 +132,7 @@ log_sum_exp !a !b
{-# INLINE log_sum_exp #-}
-- | @log 2@ as a shared constant. Used both as the initial value of
--- the two-sided running max-log-sum (since @K^+_0 + K^-_0 = 2@) and
+-- the two-sided running sup-log-sum (since @K^+_0 + K^-_0 = 2@) and
-- as the tight upper-bound slack in the fast-path skip inside
-- 'Numeric.Eproc.Bounded.update' /
-- 'Numeric.Eproc.Bernoulli.TwoSided.update'.
diff --git a/lib/Numeric/Eproc/Paired.hs b/lib/Numeric/Eproc/Paired.hs
@@ -63,6 +63,7 @@ module Numeric.Eproc.Paired (
-- * Inspection
, log_wealth
+ , log_wealth_sup
, samples
) where
@@ -143,15 +144,27 @@ decide (Config c) (State s) = Bounded.decide c s
-- inspection -----------------------------------------------------------------
--- | The supremum-so-far log-wealth of the underlying bounded-mean
--- test on the differences.
+-- | The current @log(K^+_t + K^-_t)@ of the underlying bounded-mean
+-- test on the differences. Not monotone; bounded above by
+-- 'log_wealth_sup'. Starts at @log 2@.
--
-- >>> log_wealth s0
--- 0.0
+-- 0.6931471805599453
log_wealth :: State -> Double
log_wealth (State s) = Bounded.log_wealth s
{-# INLINE log_wealth #-}
+-- | The supremum-so-far of @log(K^+_t + K^-_t)@ from the underlying
+-- bounded-mean test on the differences. Monotone nondecreasing;
+-- 'decide' rejects exactly when it crosses @log(2 \/ alpha)@.
+-- Starts at @log 2@.
+--
+-- >>> log_wealth_sup s0
+-- 0.6931471805599453
+log_wealth_sup :: State -> Double
+log_wealth_sup (State s) = Bounded.log_wealth_sup s
+{-# INLINE log_wealth_sup #-}
+
-- | The number of paired observations consumed so far.
--
-- >>> samples s0
diff --git a/test/Main.hs b/test/Main.hs
@@ -517,14 +517,15 @@ safety_property_tests = testGroup "safety properties" [
QC.forAll (QC.listOf unit_double) $ \xs ->
let cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 b)
st = foldl' (Bounded.update cfg) (Bounded.initial cfg) xs
- in finite (Bounded.log_wealth st)
+ in finite (Bounded.log_wealth st) &&
+ finite (Bounded.log_wealth_sup st)
, QC.testProperty "Bernoulli: log_wealth finite after any admissible stream" $
QC.forAll arb_bettor $ \b ->
QC.forAll QC.arbitrary $ \xs ->
let cfg = ok (Bern.config 0.05 1.0e-3 b)
st = foldl' (Bern.update cfg) (Bern.initial cfg) (xs :: [Bool])
- in finite (Bern.log_wealth st)
+ in finite (Bern.log_wealth st) && finite (Bern.log_wealth_sup st)
, QC.testProperty "Bounded: Fixed with arbitrary lambda is safe" $
QC.forAll (QC.choose (-1000, 1000)) $ \lam ->
@@ -540,22 +541,36 @@ safety_property_tests = testGroup "safety properties" [
st = foldl' (Bern.update cfg) (Bern.initial cfg) (xs :: [Bool])
in finite (Bern.log_wealth st)
- , QC.testProperty "Bounded: log_wealth is monotone nondecreasing" $
+ , QC.testProperty "Bounded: log_wealth_sup is monotone nondecreasing" $
QC.forAll arb_bettor $ \b ->
QC.forAll (QC.listOf unit_double) $ \xs ->
let cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 b)
sts = scanl (Bounded.update cfg) (Bounded.initial cfg) xs
- lws = map Bounded.log_wealth sts
+ lws = map Bounded.log_wealth_sup sts
in and (zipWith (<=) lws (drop 1 lws))
- , QC.testProperty "Bernoulli: log_wealth is monotone nondecreasing" $
+ , QC.testProperty "Bernoulli: log_wealth_sup is monotone nondecreasing" $
QC.forAll arb_bettor $ \b ->
QC.forAll QC.arbitrary $ \xs ->
let cfg = ok (Bern.config 0.05 1.0e-3 b)
sts = scanl (Bern.update cfg) (Bern.initial cfg) (xs :: [Bool])
- lws = map Bern.log_wealth sts
+ lws = map Bern.log_wealth_sup sts
in and (zipWith (<=) lws (drop 1 lws))
+ , QC.testProperty "Bounded: log_wealth bounded above by log_wealth_sup" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll (QC.listOf unit_double) $ \xs ->
+ let cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 b)
+ sts = scanl (Bounded.update cfg) (Bounded.initial cfg) xs
+ in all (\s -> Bounded.log_wealth s <= Bounded.log_wealth_sup s) sts
+
+ , QC.testProperty "Bernoulli: log_wealth bounded above by log_wealth_sup" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll QC.arbitrary $ \xs ->
+ let cfg = ok (Bern.config 0.05 1.0e-3 b)
+ sts = scanl (Bern.update cfg) (Bern.initial cfg) (xs :: [Bool])
+ in all (\s -> Bern.log_wealth s <= Bern.log_wealth_sup s) sts
+
, QC.testProperty "Bounded: rejection is latched" $
QC.forAll arb_bettor $ \b ->
QC.forAll (QC.listOf unit_double) $ \xs ->
@@ -577,7 +592,7 @@ safety_property_tests = testGroup "safety properties" [
QC.forAll QC.arbitrary $ \xs ->
let cfg = ok (BernTS.config 0.5 1.0e-3 b)
st = foldl' (BernTS.update cfg) (BernTS.initial cfg) (xs :: [Bool])
- in finite (BernTS.log_wealth st)
+ in finite (BernTS.log_wealth st) && finite (BernTS.log_wealth_sup st)
, QC.testProperty "BernTS: Fixed with arbitrary lambda is safe" $
QC.forAll (QC.choose (-1000, 1000)) $ \lam ->
@@ -586,14 +601,21 @@ safety_property_tests = testGroup "safety properties" [
st = foldl' (BernTS.update cfg) (BernTS.initial cfg) (xs :: [Bool])
in finite (BernTS.log_wealth st)
- , QC.testProperty "BernTS: log_wealth is monotone nondecreasing" $
+ , QC.testProperty "BernTS: log_wealth_sup is monotone nondecreasing" $
QC.forAll arb_bettor $ \b ->
QC.forAll QC.arbitrary $ \xs ->
let cfg = ok (BernTS.config 0.5 1.0e-3 b)
sts = scanl (BernTS.update cfg) (BernTS.initial cfg) (xs :: [Bool])
- lws = map BernTS.log_wealth sts
+ lws = map BernTS.log_wealth_sup sts
in and (zipWith (<=) lws (drop 1 lws))
+ , QC.testProperty "BernTS: log_wealth bounded above by log_wealth_sup" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll QC.arbitrary $ \xs ->
+ let cfg = ok (BernTS.config 0.5 1.0e-3 b)
+ sts = scanl (BernTS.update cfg) (BernTS.initial cfg) (xs :: [Bool])
+ in all (\s -> BernTS.log_wealth s <= BernTS.log_wealth_sup s) sts
+
, QC.testProperty "BernTS: rejection is latched" $
QC.forAll arb_bettor $ \b ->
QC.forAll QC.arbitrary $ \xs ->
