commit e13bae8f4a7ef5c918f1a38071281b1653a736ff
parent 05542c668916429b9dd6b0ddafe42c88da145ffb
Author: Jared Tobin <jared@jtobin.io>
Date: Thu, 2 Jul 2026 17:22:58 -0230
api: log_wealth is now the current value; add log_wealth_sup
Downstream wants to observe the running log-wealth, not just the
latched supremum. Split the accessor, uniformly across Bounded,
Paired, Bernoulli, and Bernoulli.TwoSided:
- log_wealth now returns the current log-wealth: for the
two-sided modules, log(K^+ + K^-) recomputed on demand via
log_sum_exp; for the one-sided Bernoulli, the running field.
- log_wealth_sup returns the supremum-so-far statistic that
'decide' monitors, i.e. what log_wealth returned previously.
Internal fields renamed to match (st_max_log_sum ->
st_sup_log_sum, st_max_log_w -> st_sup_log_w).
Also fixes the stale Paired 'log_wealth s0' Haddock example,
which claimed 0.0 but has started at log 2 since the switch to
the convex-hedge combination.
Property tests updated: monotonicity now targets log_wealth_sup,
finiteness covers both accessors, and a new property checks that
log_wealth is bounded above by log_wealth_sup along the whole
stream (exact, since both derive from the same log_sum_exp
values).
Diffstat:
6 files changed, 116 insertions(+), 37 deletions(-)
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 ->
