commit 768d004f1949a588f2a8293e2c6ff42be15e7daf
parent 3b66da8d75aef92493c251a3b2e8039c86ad91fb
Author: Jared Tobin <jared@jtobin.io>
Date: Fri, 3 Jul 2026 14:20:04 -0230
Merge branch 'impl/evalue-accessors'
Calibrated evidence accessors across all four test modules:
* log_evalue: current log e-value, normalized so a fresh state
sits at zero (log_wealth less log 2 for the hedged modules,
log_wealth itself for the one-sided Bernoulli test). Uniform
across modules, and the natural input for convex combinations
of e-processes.
* log_evalue_sup: the running supremum of the above.
* p_value: the anytime-valid p-value min 1 (exp (negate
log_evalue_sup)); decide remains equivalent to comparing it
against the configured alpha.
Property tests pin the decide/p_value equivalence, monotonicity,
normalization at fresh states, and the relation to log_wealth.
Validated with and without -f+llvm.
Diffstat:
5 files changed, 263 insertions(+), 0 deletions(-)
diff --git a/lib/Numeric/Eproc/Bernoulli.hs b/lib/Numeric/Eproc/Bernoulli.hs
@@ -73,6 +73,9 @@ module Numeric.Eproc.Bernoulli (
-- * Inspection
, log_wealth
, log_wealth_sup
+ , log_evalue
+ , log_evalue_sup
+ , p_value
, samples
) where
@@ -255,6 +258,47 @@ log_wealth_sup :: State -> Double
log_wealth_sup = st_sup_log_w
{-# INLINE log_wealth_sup #-}
+-- | The current log e-value. For this one-sided test the single
+-- wealth process is itself the e-process (a fresh state already
+-- sits at wealth @1@), so this coincides with 'log_wealth'; the
+-- accessor exists so that e-values read uniformly across test
+-- modules regardless of their internal hedging, e.g. when
+-- convex-combining several e-processes. Not monotone; bounded
+-- above by 'log_evalue_sup'.
+--
+-- >>> log_evalue s0
+-- 0.0
+log_evalue :: State -> Double
+log_evalue = st_log_w
+{-# INLINE log_evalue #-}
+
+-- | The supremum-so-far of the log e-value; coincides with
+-- 'log_wealth_sup' for this one-sided test. Monotone
+-- nondecreasing, starting at @0@; 'decide' rejects exactly when
+-- it crosses @log(1 \/ alpha)@.
+--
+-- >>> log_evalue_sup s0
+-- 0.0
+log_evalue_sup :: State -> Double
+log_evalue_sup = st_sup_log_w
+{-# INLINE log_evalue_sup #-}
+
+-- | The anytime-valid p-value: the reciprocal of the largest
+-- e-value attained so far, @min 1 (exp (negate (log_evalue_sup
+-- s)))@.
+--
+-- Monotone nonincreasing in the sample count, and valid under
+-- optional stopping: under @H_0@,
+-- @P(exists t: p_t <= alpha) <= alpha@ for every @alpha@
+-- simultaneously. 'decide' returns 'Reject' exactly when this
+-- value has reached the configured @alpha@ or below.
+--
+-- >>> p_value s0
+-- 1.0
+p_value :: State -> Double
+p_value s = min 1 (exp (negate (log_evalue_sup s)))
+{-# INLINE p_value #-}
+
-- | The number of samples consumed so far.
--
-- >>> samples s0
diff --git a/lib/Numeric/Eproc/Bernoulli/TwoSided.hs b/lib/Numeric/Eproc/Bernoulli/TwoSided.hs
@@ -55,6 +55,9 @@ module Numeric.Eproc.Bernoulli.TwoSided (
-- * Inspection
, log_wealth
, log_wealth_sup
+ , log_evalue
+ , log_evalue_sup
+ , p_value
, samples
) where
@@ -142,6 +145,38 @@ log_wealth_sup :: State -> Double
log_wealth_sup (State s) = Bounded.log_wealth_sup s
{-# INLINE log_wealth_sup #-}
+-- | The current log e-value of the underlying bounded-mean test:
+-- 'log_wealth' minus @log 2@, normalized so a fresh state sits at
+-- @0@. Not monotone; bounded above by 'log_evalue_sup'.
+--
+-- >>> log_evalue s0
+-- 0.0
+log_evalue :: State -> Double
+log_evalue (State s) = Bounded.log_evalue s
+{-# INLINE log_evalue #-}
+
+-- | The supremum-so-far of the log e-value: 'log_wealth_sup' minus
+-- @log 2@. Monotone nondecreasing, starting at @0@; 'decide'
+-- rejects exactly when it crosses @log(1 \/ alpha)@.
+--
+-- >>> log_evalue_sup s0
+-- 0.0
+log_evalue_sup :: State -> Double
+log_evalue_sup (State s) = Bounded.log_evalue_sup s
+{-# INLINE log_evalue_sup #-}
+
+-- | The anytime-valid p-value: the reciprocal of the largest
+-- e-value attained so far. Monotone nonincreasing; under @H_0@,
+-- @P(exists t: p_t <= alpha) <= alpha@ for every @alpha@
+-- simultaneously. 'decide' returns 'Reject' exactly when this
+-- value has reached the configured @alpha@ or below.
+--
+-- >>> p_value s0
+-- 1.0
+p_value :: State -> Double
+p_value (State s) = Bounded.p_value s
+{-# INLINE p_value #-}
+
-- | The number of samples consumed so far.
--
-- >>> samples s0
diff --git a/lib/Numeric/Eproc/Bounded.hs b/lib/Numeric/Eproc/Bounded.hs
@@ -84,6 +84,9 @@ module Numeric.Eproc.Bounded (
-- * Inspection
, log_wealth
, log_wealth_sup
+ , log_evalue
+ , log_evalue_sup
+ , p_value
, samples
) where
@@ -311,6 +314,47 @@ log_wealth_sup :: State -> Double
log_wealth_sup State{..} = st_sup_log_sum
{-# INLINE log_wealth_sup #-}
+-- | The current log e-value of the convex-hedge e-process: the log
+-- of @(K^+_t + K^-_t) \/ 2@, i.e. 'log_wealth' minus @log 2@.
+--
+-- Unlike 'log_wealth', this is normalized so that a fresh state
+-- sits at @0@ (e-value @1@): it is directly comparable across
+-- test modules regardless of their internal hedging, and is the
+-- form to use when convex-combining several e-processes. Not
+-- monotone; bounded above by 'log_evalue_sup'.
+--
+-- >>> log_evalue s0
+-- 0.0
+log_evalue :: State -> Double
+log_evalue s = log_wealth s - log2_dbl
+{-# INLINE log_evalue #-}
+
+-- | The supremum-so-far of the log e-value: 'log_wealth_sup' minus
+-- @log 2@. Monotone nondecreasing, starting at @0@; 'decide'
+-- rejects exactly when it crosses @log(1 \/ alpha)@.
+--
+-- >>> log_evalue_sup s0
+-- 0.0
+log_evalue_sup :: State -> Double
+log_evalue_sup s = log_wealth_sup s - log2_dbl
+{-# INLINE log_evalue_sup #-}
+
+-- | The anytime-valid p-value: the reciprocal of the largest
+-- e-value attained so far, @min 1 (exp (negate (log_evalue_sup
+-- s)))@.
+--
+-- Monotone nonincreasing in the sample count, and valid under
+-- optional stopping: under @H_0@,
+-- @P(exists t: p_t <= alpha) <= alpha@ for every @alpha@
+-- simultaneously. 'decide' returns 'Reject' exactly when this
+-- value has reached the configured @alpha@ or below.
+--
+-- >>> p_value s0
+-- 1.0
+p_value :: State -> Double
+p_value s = min 1 (exp (negate (log_evalue_sup s)))
+{-# INLINE p_value #-}
+
-- | The number of samples consumed so far.
--
-- >>> samples s0
diff --git a/lib/Numeric/Eproc/Paired.hs b/lib/Numeric/Eproc/Paired.hs
@@ -64,6 +64,9 @@ module Numeric.Eproc.Paired (
-- * Inspection
, log_wealth
, log_wealth_sup
+ , log_evalue
+ , log_evalue_sup
+ , p_value
, samples
) where
@@ -165,6 +168,39 @@ log_wealth_sup :: State -> Double
log_wealth_sup (State s) = Bounded.log_wealth_sup s
{-# INLINE log_wealth_sup #-}
+-- | The current log e-value of the underlying bounded-mean test on
+-- the differences: 'log_wealth' minus @log 2@, normalized so a
+-- fresh state sits at @0@. Not monotone; bounded above by
+-- 'log_evalue_sup'.
+--
+-- >>> log_evalue s0
+-- 0.0
+log_evalue :: State -> Double
+log_evalue (State s) = Bounded.log_evalue s
+{-# INLINE log_evalue #-}
+
+-- | The supremum-so-far of the log e-value: 'log_wealth_sup' minus
+-- @log 2@. Monotone nondecreasing, starting at @0@; 'decide'
+-- rejects exactly when it crosses @log(1 \/ alpha)@.
+--
+-- >>> log_evalue_sup s0
+-- 0.0
+log_evalue_sup :: State -> Double
+log_evalue_sup (State s) = Bounded.log_evalue_sup s
+{-# INLINE log_evalue_sup #-}
+
+-- | The anytime-valid p-value: the reciprocal of the largest
+-- e-value attained so far. Monotone nonincreasing; under @H_0@,
+-- @P(exists t: p_t <= alpha) <= alpha@ for every @alpha@
+-- simultaneously. 'decide' returns 'Reject' exactly when this
+-- value has reached the configured @alpha@ or below.
+--
+-- >>> p_value s0
+-- 1.0
+p_value :: State -> Double
+p_value (State s) = Bounded.p_value s
+{-# INLINE p_value #-}
+
-- | The number of paired observations consumed so far.
--
-- >>> samples s0
diff --git a/test/Main.hs b/test/Main.hs
@@ -25,6 +25,7 @@ main = defaultMain $ testGroup "ppad-eproc" [
, config_validation_tests
, safety_property_tests
, two_sided_bernoulli_tests
+ , evalue_accessor_tests
]
-- partial helper: tests below hardcode valid configs.
@@ -624,3 +625,106 @@ safety_property_tests = testGroup "safety properties" [
vs = map (BernTS.decide cfg) sts
in monotone_reject_bern_ts vs
]
+
+-- e-value accessors ----------------------------------------------------------
+
+unit_pair :: QC.Gen (Double, Double)
+unit_pair = (,) <$> unit_double <*> unit_double
+
+evalue_accessor_tests :: TestTree
+evalue_accessor_tests = testGroup "e-value accessors" [
+ testCase "fresh states normalize to e-value 1, p-value 1" $ do
+ let bcfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
+ ncfg = ok (Bern.config 0.05 1.0e-3 Bern.Newton)
+ tcfg = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)
+ pcfg = ok (P.config 0.0 1.0 1.0e-3 Bounded.Newton)
+ Bounded.log_evalue (Bounded.initial bcfg) @?= 0.0
+ Bounded.log_evalue_sup (Bounded.initial bcfg) @?= 0.0
+ Bounded.p_value (Bounded.initial bcfg) @?= 1.0
+ Bern.log_evalue (Bern.initial ncfg) @?= 0.0
+ Bern.p_value (Bern.initial ncfg) @?= 1.0
+ BernTS.log_evalue (BernTS.initial tcfg) @?= 0.0
+ BernTS.p_value (BernTS.initial tcfg) @?= 1.0
+ P.log_evalue (P.initial pcfg) @?= 0.0
+ P.p_value (P.initial pcfg) @?= 1.0
+
+ , QC.testProperty "Bounded: log_evalue is log_wealth less log 2" $
+ 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)
+ st = foldl' (Bounded.update cfg) (Bounded.initial cfg) xs
+ in Bounded.log_evalue st == Bounded.log_wealth st - C.log2_dbl
+
+ , QC.testProperty "Bernoulli: log_evalue coincides with log_wealth" $
+ 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 Bern.log_evalue st == Bern.log_wealth st
+
+ , QC.testProperty "Bounded: decide agrees with p_value at alpha" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll (QC.listOf unit_double) $ \xs ->
+ let alpha = 0.5
+ cfg = ok (Bounded.config 0.5 0.0 1.0 alpha b)
+ sts = scanl (Bounded.update cfg) (Bounded.initial cfg) xs
+ in all (\s -> (Bounded.decide cfg s == Bounded.Reject)
+ == (Bounded.p_value s <= alpha)) sts
+
+ , QC.testProperty "Bernoulli: decide agrees with p_value at alpha" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll QC.arbitrary $ \xs ->
+ let alpha = 0.5
+ cfg = ok (Bern.config 0.5 alpha b)
+ sts = scanl (Bern.update cfg) (Bern.initial cfg)
+ (xs :: [Bool])
+ in all (\s -> (Bern.decide cfg s == Bern.Reject)
+ == (Bern.p_value s <= alpha)) sts
+
+ , QC.testProperty "BernTS: decide agrees with p_value at alpha" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll QC.arbitrary $ \xs ->
+ let alpha = 0.5
+ cfg = ok (BernTS.config 0.5 alpha b)
+ sts = scanl (BernTS.update cfg) (BernTS.initial cfg)
+ (xs :: [Bool])
+ in all (\s -> (BernTS.decide cfg s == BernTS.Reject)
+ == (BernTS.p_value s <= alpha)) sts
+
+ , QC.testProperty "Bounded: p_value monotone nonincreasing" $
+ 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
+ ps = map Bounded.p_value sts
+ in and (zipWith (>=) ps (drop 1 ps))
+
+ , QC.testProperty "Paired: p_value monotone nonincreasing" $
+ QC.forAll arb_bettor $ \b ->
+ QC.forAll (QC.listOf unit_pair) $ \ps ->
+ let cfg = ok (P.config 0.0 1.0 1.0e-3 b)
+ sts = scanl (P.update cfg) (P.initial cfg) ps
+ pv = map P.p_value sts
+ in and (zipWith (>=) pv (drop 1 pv))
+
+ , QC.testProperty "Bounded: p_value in [0, 1], evalue below 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 -> let p = Bounded.p_value s
+ in p >= 0 && p <= 1 &&
+ Bounded.log_evalue s
+ <= Bounded.log_evalue_sup s) sts
+
+ , QC.testProperty "Bernoulli: p_value in [0, 1], evalue below 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 -> let p = Bern.p_value s
+ in p >= 0 && p <= 1 &&
+ Bern.log_evalue s
+ <= Bern.log_evalue_sup s) sts
+ ]
