ppad-eproc 0.2.1 → 0.2.2

raw patch · 9 files changed

+375/−24 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +4/−0
• bench/Main.hs +31/−0
• bench/Weight.hs +29/−0
• lib/Numeric/Eproc/Bernoulli.hs +8/−6
• lib/Numeric/Eproc/Bernoulli/TwoSided.hs +139/−0
• lib/Numeric/Eproc/Bounded.hs +13/−15
• lib/Numeric/Eproc/Common.hs +23/−0
• ppad-eproc.cabal +4/−3
• test/Main.hs +124/−0

@@ -1,5 +1,9 @@ # Changelog +- 0.2.2 (2026-07-02)+  * Adds a Numeric.Eproc.Bernoulli.TwoSided module for a two-sided+    Bernoulli rate test.+ - 0.2.1 (2026-07-02)   * Two-sided bounded-mean tests now reject faster, or at least never     later.

@@ -5,6 +5,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.Paired as P import Criterion.Main@@ -15,6 +16,7 @@ instance NFData Bounded.State    where rnf !_ = () instance NFData P.State          where rnf !_ = () instance NFData Bern.State       where rnf !_ = ()+instance NFData BernTS.State     where rnf !_ = () instance NFData Bounded.Verdict  where rnf !_ = ()  -- partial helper for benches: configs here are hardcoded valid, so a@@ -31,6 +33,8 @@   , twosample   , bern_update   , bern_stream+  , bern_ts_update+  , bern_ts_stream   ]  update :: Benchmark@@ -104,6 +108,33 @@       !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)       run_b cfg = foldl' (Bern.update cfg) (Bern.initial cfg)   in  bgroup "Bernoulli.update (1000-sample fold)" [+          bench "fixed"    $ nf (run_b cfg_f) xs+        , bench "adaptive" $ nf (run_b cfg_a) xs+        , bench "newton"   $ nf (run_b cfg_o) xs+        ]++bern_ts_update :: Benchmark+bern_ts_update =+  let !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))+      !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)+      !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+      !st_f  = BernTS.initial cfg_f+      !st_a  = BernTS.initial cfg_a+      !st_o  = BernTS.initial cfg_o+  in  bgroup "Bernoulli.TwoSided.update (one step)" [+          bench "fixed"    $ nf (BernTS.update cfg_f st_f) True+        , bench "adaptive" $ nf (BernTS.update cfg_a st_a) True+        , bench "newton"   $ nf (BernTS.update cfg_o st_o) True+        ]++bern_ts_stream :: Benchmark+bern_ts_stream =+  let !xs    = force (take 1000 (cycle [True, False]))+      !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))+      !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)+      !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+      run_b cfg = foldl' (BernTS.update cfg) (BernTS.initial cfg)+  in  bgroup "Bernoulli.TwoSided.update (1000-sample fold)" [           bench "fixed"    $ nf (run_b cfg_f) xs         , bench "adaptive" $ nf (run_b cfg_a) xs         , bench "newton"   $ nf (run_b cfg_o) xs

@@ -5,6 +5,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.Paired as P import Weigh@@ -12,6 +13,7 @@ instance NFData Bounded.State    where rnf !_ = () instance NFData P.State          where rnf !_ = () instance NFData Bern.State       where rnf !_ = ()+instance NFData BernTS.State     where rnf !_ = () instance NFData Bounded.Verdict  where rnf !_ = ()  -- partial helper for benches: configs here are hardcoded valid.@@ -28,6 +30,8 @@   twosample   bern_update   bern_stream+  bern_ts_update+  bern_ts_stream  update :: Weigh () update =@@ -94,6 +98,31 @@       !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)       run_b cfg = foldl' (Bern.update cfg) (Bern.initial cfg)   in  wgroup "Bernoulli.update (1000-sample fold)" $ do+        func "fixed"    (run_b cfg_f) xs+        func "adaptive" (run_b cfg_a) xs+        func "newton"   (run_b cfg_o) xs++bern_ts_update :: Weigh ()+bern_ts_update =+  let !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))+      !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)+      !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+      !st_f  = BernTS.initial cfg_f+      !st_a  = BernTS.initial cfg_a+      !st_o  = BernTS.initial cfg_o+  in  wgroup "Bernoulli.TwoSided.update (one step)" $ do+        func "fixed"    (BernTS.update cfg_f st_f) True+        func "adaptive" (BernTS.update cfg_a st_a) True+        func "newton"   (BernTS.update cfg_o st_o) True++bern_ts_stream :: Weigh ()+bern_ts_stream =+  let !xs    = force (take 1000 (cycle [True, False]))+      !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))+      !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)+      !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+      run_b cfg = foldl' (BernTS.update cfg) (BernTS.initial cfg)+  in  wgroup "Bernoulli.TwoSided.update (1000-sample fold)" $ do         func "fixed"    (run_b cfg_f) xs         func "adaptive" (run_b cfg_a) xs         func "newton"   (run_b cfg_o) xs

@@ -8,7 +8,9 @@ -- License: MIT -- Maintainer: Jared Tobin <jared@ppad.tech> ----- One-sided Bernoulli rate anytime-valid test.+-- One-sided Bernoulli rate anytime-valid test. See+-- "Numeric.Eproc.Bernoulli.TwoSided" for the two-sided companion+-- (used for the sign test at @p_0 = 1\/2@, among other things). -- -- For samples @x_t@ in @{0, 1}@, tests --@@ -36,9 +38,9 @@ -- 'Reject' even if subsequent observations drive the current -- wealth back below threshold. ----- Unlike "Numeric.Eproc.Bounded", the alternative here is one-sided,--- so a single wealth process suffices and no Bonferroni adjustment--- is needed -- the rejection threshold is @log(1 \/ alpha)@.+-- The alternative here is one-sided, so a single wealth process+-- suffices and no Bonferroni or hedge adjustment is needed -- the+-- rejection threshold is @log(1 \/ alpha)@. -- -- == Example --@@ -73,6 +75,7 @@   , samples   ) where +import GHC.Float (log1p) import Numeric.Eproc.Common (     Bettor(..), Verdict(..), ConfigError(..)   , BetState, init_bet, bet_lambda, step_bet@@ -198,8 +201,7 @@   let !xd     = if x then 1 else 0       !z      = xd - cfg_p0       !lam    = bet_lambda cfg_bettor cfg_lam_max st_bet-      !fac    = 1 + lam * z-      !logw'  = st_log_w + log fac+      !logw'  = st_log_w + log1p (lam * z)       !maxw'  = max st_max_log_w logw'       !s'     = step_bet cfg_bettor cfg_lam_max st_bet z   in  State (st_n + 1) logw' maxw' s'

@@ -0,0 +1,139 @@+{-# OPTIONS_HADDOCK prune #-}+{-# LANGUAGE BangPatterns #-}++-- |+-- Module: Numeric.Eproc.Bernoulli.TwoSided+-- Copyright: (c) 2026 Jared Tobin+-- License: MIT+-- Maintainer: Jared Tobin <jared@ppad.tech>+--+-- Two-sided Bernoulli rate anytime-valid test. Companion to+-- "Numeric.Eproc.Bernoulli", which handles the one-sided case;+-- reach for this module when you want to test+--+--     @H_0: E[x_t | F_{t-1}] = p_0   for all t@+--+-- against the negation. The canonical case is the sign test at+-- @p_0 = 1\/2@.+--+-- 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+--+-- Sign test at @p_0 = 1\/2@ with a downward shift:+--+-- >>> let Right cfg = config 0.5 1.0e-3 Newton+-- >>> let s0 = initial cfg+-- >>> let xs = take 500 (cycle [False, False, False, True])+-- >>> decide cfg (foldl' (update cfg) s0 xs)+-- Reject++module Numeric.Eproc.Bernoulli.TwoSided (+  -- * Test configuration and state+    Config+  , State+  , Verdict(..)+  , ConfigError(..)++  -- * Bettor strategies+  , Bettor(..)++  -- * Construction+  , config+  , initial++  -- * Streaming+  , update+  , decide++  -- * Inspection+  , log_wealth+  , samples+  ) where++import qualified Numeric.Eproc.Bounded as Bounded+import Numeric.Eproc.Common (Bettor(..), Verdict(..), ConfigError(..))++-- types ----------------------------------------------------------------------++-- | Two-sided Bernoulli rate test configuration. Build with 'config'.+--   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'.+newtype State = State Bounded.State++-- construction ---------------------------------------------------------------++-- | Build a 'Config' for the two-sided Bernoulli rate test.+--+--   Returns 'Left' with a 'ConfigError' on inputs that would leave+--   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+  :: Double  -- ^ baseline rate @p_0@, in @(0, 1)@+  -> Double  -- ^ significance level @alpha@, in @(0, 1)@+  -> Bettor  -- ^ bettor strategy+  -> Either ConfigError Config+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.+--+--   >>> let s0 = initial cfg+initial :: Config -> State+initial (Config c) = State (Bounded.initial c)+{-# INLINE initial #-}++-- streaming ------------------------------------------------------------------++-- | 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 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'.+--+--   >>> decide cfg s0+--   Continue+decide :: Config -> State -> Verdict+decide (Config c) (State s) = Bounded.decide c s+{-# INLINE decide #-}++-- inspection -----------------------------------------------------------------++-- | 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 (State s) = Bounded.log_wealth s+{-# INLINE log_wealth #-}++-- | The number of samples consumed so far.+--+--   >>> samples s0+--   0+samples :: State -> Int+samples (State s) = Bounded.samples s+{-# INLINE samples #-}

@@ -90,7 +90,7 @@ import Numeric.Eproc.Common (     Bettor(..), Verdict(..), ConfigError(..)   , BetState, init_bet, bet_lambda, step_bet-  , finite+  , finite, log_sum_exp, log2_dbl   )  -- types ----------------------------------------------------------------------@@ -210,7 +210,7 @@         st_n           = 0       , st_log_w_pos   = 0       , st_log_w_neg   = 0-      , st_max_log_sum = log 2+      , st_max_log_sum = log2_dbl       , st_bet_pos     = s0       , st_bet_neg     = s0       }@@ -243,23 +243,21 @@   let !z       = x - cfg_null_mean       !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-      !fac_p   = 1 + lam_p * z-      !fac_n   = 1 - lam_n * z-      !logw_p  = st_log_w_pos + log fac_p-      !logw_n  = st_log_w_neg + log fac_n-      !log_sum = log_sum_exp logw_p logw_n-      !max_sum = max st_max_log_sum log_sum+      !logw_p  = st_log_w_pos + log1p (lam_p * z)+      !logw_n  = st_log_w_neg + log1p (negate lam_n * z)+      -- Skip 'log_sum_exp' when the cheap upper bound+      --   log_sum_exp a b <= max a b + log 2+      -- 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+        | 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 {-# INLINE update #-}---- | @log(exp a + exp b)@, computed without intermediate overflow.-log_sum_exp :: Double -> Double -> Double-log_sum_exp !a !b-  | a >= b    = a + log1p (exp (b - a))-  | otherwise = b + log1p (exp (a - b))-{-# INLINE log_sum_exp #-}  -- | Compute the current 'Verdict' from the running 'State'. --

@@ -32,8 +32,12 @@    -- * Internal: helpers   , finite+  , log_sum_exp+  , log2_dbl   ) where +import GHC.Float (log1p)+ -- | A predictable bettor. -- --   A bettor describes how, given the history of centred@@ -116,6 +120,25 @@ finite :: Double -> Bool finite x = not (isNaN x) && not (isInfinite x) {-# INLINE finite #-}++-- | @log(exp a + exp b)@, computed without intermediate overflow.+--   Used by the convex-hedge two-sided combinations to update the+--   running @log(K^+ + K^-)@ statistic from the two per-direction+--   log-wealths.+log_sum_exp :: Double -> Double -> Double+log_sum_exp !a !b+  | a >= b    = a + log1p (exp (b - a))+  | otherwise = b + log1p (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+--   as the tight upper-bound slack in the fast-path skip inside+--   'Numeric.Eproc.Bounded.update' /+--   'Numeric.Eproc.Bernoulli.TwoSided.update'.+log2_dbl :: Double+log2_dbl = log 2+{-# INLINE log2_dbl #-}  -- | Per-bettor state. One constructor per 'Bettor' alternative; the --   constructor used in any given state matches the 'Bettor' chosen

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               ppad-eproc-version:            0.2.1+version:            0.2.2 synopsis:           Anytime-valid sequential testing via e-processes. license:            MIT license-file:       LICENSE@@ -13,8 +13,8 @@ description:   Anytime-valid sequential hypothesis testing for bounded random   variables, via the e-process / betting framework of Waudby-Smith and-  Ramdas (2024). Provides bounded-mean, paired two-sample, and-  one-sided Bernoulli rate tests with fixed, adaptive (aGRAPA), and+  Ramdas (2024). Provides bounded-mean, paired two-sample, and one- and+  two-sided Bernoulli rate tests with fixed, adaptive (aGRAPA), and   online Newton bettors.  flag llvm@@ -35,6 +35,7 @@     ghc-options: -fllvm -O2   exposed-modules:       Numeric.Eproc.Bernoulli+      Numeric.Eproc.Bernoulli.TwoSided       Numeric.Eproc.Bounded       Numeric.Eproc.Common       Numeric.Eproc.Paired

@@ -5,6 +5,7 @@ import Data.Bits import Data.Word 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.Paired as P@@ -23,6 +24,7 @@   , latched_rejection_tests   , config_validation_tests   , safety_property_tests+  , two_sided_bernoulli_tests   ]  -- partial helper: tests below hardcode valid configs.@@ -391,6 +393,93 @@       Left _  -> pure ()       Right _ -> assertFailure "expected Left" +-- two-sided bernoulli --------------------------------------------------------++run_ts_bernoulli+  :: BernTS.Config+  -> Double           -- ^ true rate p+  -> Int              -- ^ budget+  -> Gen+  -> (BernTS.Verdict, Int)+run_ts_bernoulli cfg p budget g0 =+  go 0 g0 (BernTS.initial cfg)+  where+    go !n !g !st+      | n >= budget = (BernTS.decide cfg st, n)+      | otherwise = case BernTS.decide cfg st of+          BernTS.Reject -> (BernTS.Reject, n)+          BernTS.Continue ->+            let (u, g') = next_double g+                !x      = u < p+                st'     = BernTS.update cfg st x+            in  go (n + 1) g' st'++ts_bernoulli_rate+  :: BernTS.Config+  -> Double+  -> Int+  -> Int+  -> Word64+  -> Double+ts_bernoulli_rate cfg p budget trials seed =+  let gens = take trials (gen_seq (mk_gen seed))+      rejects = length+        [ () | g <- gens+             , let (v, _) = run_ts_bernoulli cfg p budget g+             , v == BernTS.Reject ]+  in  fromIntegral rejects / fromIntegral trials++two_sided_bernoulli_tests :: TestTree+two_sided_bernoulli_tests = testGroup "two-sided bernoulli" [+    testCase "constant at p_0 doesn't reject" $ do+      -- Bernoulli(0.5) with p_0 = 0.5 is under the null.+      let cfg = ok (BernTS.config 0.5 1.0e-6 BernTS.Newton)+          -- alternating True/False keeps the empirical rate at 0.5.+          xs  = take 5000 (cycle [True, False])+          st  = foldl' (BernTS.update cfg) (BernTS.initial cfg) xs+      BernTS.decide cfg st @?= BernTS.Continue+  , testCase "detects upward shift (p = 0.7 vs p_0 = 0.5)" $ do+      let cfg  = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+          rate = ts_bernoulli_rate cfg 0.7 5000 100 111222+      assertBool ("power " ++ show rate ++ " too low") $+        rate >= 0.95+  , testCase "detects downward shift (p = 0.3 vs p_0 = 0.5)" $ do+      let cfg  = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)+          rate = ts_bernoulli_rate cfg 0.3 5000 100 333444+      assertBool ("power " ++ show rate ++ " too low") $+        rate >= 0.95+  , testCase "Adaptive detects shift (p = 0.7 vs p_0 = 0.5)" $ do+      let cfg  = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)+          rate = ts_bernoulli_rate cfg 0.7 5000 100 777888+      assertBool ("power " ++ show rate ++ " too low") $+        rate >= 0.95+  , testCase "FPR at p = p_0 = 0.5 within slack" $ do+      let cfg  = ok (BernTS.config 0.5 0.05 BernTS.Newton)+          rate = ts_bernoulli_rate cfg 0.5 2000 200 555666+      assertBool ("FPR " ++ show rate ++ " exceeded slack") $+        rate <= 0.08+  , testCase "latched: cross then drown stays rejected" $ do+      let cfg  = ok (BernTS.config 0.5 0.5 (BernTS.Fixed 1.0))+          -- ten 1s push the positive side well past threshold.+          xs1  = replicate 10 True+          -- then two hundred 0s drop the current wealth, but the+          -- latch must hold.+          xs2  = replicate 200 False+          st1  = foldl' (BernTS.update cfg) (BernTS.initial cfg) xs1+          st2  = foldl' (BernTS.update cfg) st1 xs2+      BernTS.decide cfg st1 @?= BernTS.Reject+      BernTS.decide cfg st2 @?= BernTS.Reject+  , testCase "config: NaN p0 rejected" $ do+      let nan = 0/0 :: Double+      case BernTS.config nan 0.05 BernTS.Newton of+        Left _  -> pure ()+        Right _ -> assertFailure "expected Left"+  , testCase "config: alpha out of range rejected" $+      case BernTS.config 0.5 1.5 BernTS.Newton of+        Left _  -> pure ()+        Right _ -> assertFailure "expected Left"+  ]+ -- safety properties ----------------------------------------------------------  unit_double :: QC.Gen Double@@ -416,6 +505,11 @@ monotone_reject_bern (Bern.Continue : rest) = monotone_reject_bern rest monotone_reject_bern (Bern.Reject : rest)   = all (== Bern.Reject) rest +monotone_reject_bern_ts :: [BernTS.Verdict] -> Bool+monotone_reject_bern_ts [] = True+monotone_reject_bern_ts (BernTS.Continue : rest) = monotone_reject_bern_ts rest+monotone_reject_bern_ts (BernTS.Reject : rest)   = all (== BernTS.Reject) rest+ safety_property_tests :: TestTree safety_property_tests = testGroup "safety properties" [     QC.testProperty "Bounded: log_wealth finite after any admissible stream" $@@ -477,4 +571,34 @@             sts  = scanl (Bern.update cfg) (Bern.initial cfg) (xs :: [Bool])             vs   = map (Bern.decide cfg) sts         in  monotone_reject_bern vs++  , QC.testProperty "BernTS: log_wealth finite after any admissible stream" $+      QC.forAll arb_bettor $ \b ->+      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)++  , QC.testProperty "BernTS: Fixed with arbitrary lambda is safe" $+      QC.forAll (QC.choose (-1000, 1000)) $ \lam ->+      QC.forAll QC.arbitrary $ \xs ->+        let cfg = ok (BernTS.config 0.5 1.0e-3 (C.Fixed lam))+            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.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+        in  and (zipWith (<=) lws (drop 1 lws))++  , QC.testProperty "BernTS: rejection is latched" $+      QC.forAll arb_bettor $ \b ->+      QC.forAll QC.arbitrary $ \xs ->+        let cfg  = ok (BernTS.config 0.5 0.5 b)+            sts  = scanl (BernTS.update cfg) (BernTS.initial cfg) (xs :: [Bool])+            vs   = map (BernTS.decide cfg) sts+        in  monotone_reject_bern_ts vs   ]