Common.hs (9617B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 -- | 5 -- Module: Numeric.Eproc.Common 6 -- Copyright: (c) 2026 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- Shared vocabulary for the eproc tests: the predictable bettor 11 -- strategies, the test verdict type, and the configuration-error 12 -- type. Re-exported from each test module 13 -- ("Numeric.Eproc.Bounded", "Numeric.Eproc.Paired", 14 -- "Numeric.Eproc.Bernoulli"); import this module directly only if 15 -- you need the types without picking a particular test. 16 -- 17 -- The 'BetState' type and its helpers are internal to the library: 18 -- they are exposed here so that 'Numeric.Eproc.Bounded' and 19 -- 'Numeric.Eproc.Bernoulli' can share one implementation, not for 20 -- direct use. 21 22 module Numeric.Eproc.Common ( 23 Bettor(..) 24 , Verdict(..) 25 , ConfigError(..) 26 27 -- * Internal: shared bettor state 28 , BetState(..) 29 , init_bet 30 , bet_lambda 31 , step_bet 32 33 -- * Internal: helpers 34 , finite 35 , log_sum_exp 36 , log2_dbl 37 ) where 38 39 import GHC.Float (log1p) 40 41 -- | A predictable bettor. 42 -- 43 -- A bettor describes how, given the history of centred 44 -- observations @z_t@ (each test module specifies its own centring; 45 -- see the per-module documentation), the next predictable bet 46 -- @lambda_t@ is chosen. Predictability -- that is, @lambda_t@ 47 -- depends only on data observed strictly before step @t@ -- is 48 -- what makes the resulting wealth process a nonnegative 49 -- supermartingale under @H_0@. 50 -- 51 -- All three bettors enforce a safe-bet ceiling @lambda_max@ 52 -- derived from the test's admissible-observation range by clipping 53 -- @lambda@ to @[0, lambda_max]@; this keeps the per-step wealth 54 -- factor nonnegative. 55 -- 56 -- * 'Fixed' bets the supplied constant @lambda@ (clipped to 57 -- @[0, lambda_max]@). The wager does not respond to observed 58 -- data; this strategy is useful only as a baseline. 59 -- 60 -- * 'Adaptive' is the aGRAPA (approximate growth-rate adaptive 61 -- predictable plug-in) bettor of Waudby-Smith & Ramdas (2024). 62 -- It tracks the empirical mean @mu@ and variance @sigma^2@ of 63 -- centred observations and bets the Kelly-optimal plug-in 64 -- @lambda* = mu \/ (sigma^2 + mu^2)@ clipped to 65 -- @[0, lambda_max]@. Fast to compute and competitive in 66 -- practice. 67 -- 68 -- * 'Newton' is the online Newton step (ONS) bettor of 69 -- Waudby-Smith & Ramdas (2024, Algorithm 2). The per-step 70 -- log-wealth loss @-log(1 + lambda * z)@ is convex in @lambda@; 71 -- ONS performs one Newton step per observation, accumulating 72 -- squared gradients to scale the update by a fixed learning 73 -- rate @2 \/ (2 - log 3)@. Achieves logarithmic regret against 74 -- the best constant bet in hindsight and is in practice the 75 -- strongest of the three bettors under most signal regimes. 76 -- 77 -- One deliberate deviation from WSR: Algorithm 2 seeds the 78 -- squared-gradient accumulator at @1@, which presumes 79 -- observations scaled to @[0, 1]@. On raw-scale data that 80 -- constant is dimensionally wrong -- negligible when 81 -- @z^2 >> 1@, paralysing when @z^2 << 1@ -- so the accumulator 82 -- here is instead seeded near zero, making the update 83 -- scale-adaptive. The trade is bold early play: the first 84 -- nonzero observation typically drives the bet straight to 85 -- the @lambda_max@ ceiling, annealing back toward the Kelly 86 -- point as gradients accumulate. Validity is unaffected -- 87 -- predictability and clipping are all it needs -- and regret 88 -- stays logarithmic with a somewhat larger constant. The 89 -- visible effect is higher-variance early wealth: a supremum 90 -- modestly above its floor is expected even under @H_0@. 91 data Bettor = 92 Fixed {-# UNPACK #-} !Double 93 | Adaptive 94 | Newton 95 deriving (Eq, Show) 96 97 -- | Test outcome at the current sample count. 98 -- 99 -- 'Reject' means the wealth process has /ever/ crossed the 100 -- rejection threshold, so @H_0@ is rejected at level @alpha@. 101 -- Once a state has rejected it stays rejected, even if subsequent 102 -- observations drive the current wealth back below threshold; 103 -- this is the supremum-style guarantee that Ville's inequality 104 -- actually delivers. 'Continue' means there is not yet enough 105 -- evidence; collect more samples (or stop and report no 106 -- rejection -- the type-I error guarantee holds for /any/ 107 -- stopping rule). 108 data Verdict = 109 Reject 110 | Continue 111 deriving (Eq, Show) 112 113 -- | Reasons that a test-configuration smart constructor can reject 114 -- its inputs. Returned by 'Numeric.Eproc.Bounded.config', 115 -- 'Numeric.Eproc.Bounded.configInterval', 116 -- 'Numeric.Eproc.Bernoulli.config', 117 -- 'Numeric.Eproc.Paired.config', 118 -- 'Numeric.Eproc.Mixture.config', and 119 -- 'Numeric.Eproc.ConfSeq.config'. 120 data ConfigError = 121 -- | significance level outside @(0, 1)@ 122 InvalidAlpha {-# UNPACK #-} !Double 123 -- | sample bounds violate @lo < hi@ 124 | InvalidBounds {-# UNPACK #-} !Double {-# UNPACK #-} !Double 125 -- | null mean outside @(lo, hi)@ (strict, to avoid div-by-zero 126 -- in the safe-bet ceilings) 127 | InvalidNullMean 128 {-# UNPACK #-} !Double -- m 129 {-# UNPACK #-} !Double -- lo 130 {-# UNPACK #-} !Double -- hi 131 -- | null-interval endpoints violate @lo < m_lo <= m_hi < hi@ 132 -- (strict at the sample bounds, to avoid div-by-zero in the 133 -- safe-bet ceilings) 134 | InvalidNullInterval 135 {-# UNPACK #-} !Double -- m_lo 136 {-# UNPACK #-} !Double -- m_hi 137 {-# UNPACK #-} !Double -- lo 138 {-# UNPACK #-} !Double -- hi 139 -- | baseline rate outside @(0, 1)@ 140 | InvalidBaselineRate {-# UNPACK #-} !Double 141 -- | component count not positive 142 | InvalidComponentCount {-# UNPACK #-} !Int 143 -- | grid size below @1@ 144 | InvalidGridSize {-# UNPACK #-} !Int 145 deriving (Eq, Show) 146 147 -- | True iff the argument is a finite IEEE-754 double (not NaN, not 148 -- @+\/-Infinity@). Used by the @config@ smart constructors to keep 149 -- the bounded-random-variable promise honest. 150 finite :: Double -> Bool 151 finite x = not (isNaN x) && not (isInfinite x) 152 {-# INLINE finite #-} 153 154 -- | @log(exp a + exp b)@, computed without intermediate overflow. 155 -- Used by the convex-hedge two-sided combinations to update the 156 -- running @log(K^+ + K^-)@ statistic from the two per-direction 157 -- log-wealths. 158 log_sum_exp :: Double -> Double -> Double 159 log_sum_exp !a !b 160 | a >= b = a + log1p (exp (b - a)) 161 | otherwise = b + log1p (exp (a - b)) 162 {-# INLINE log_sum_exp #-} 163 164 -- | @log 2@ as a shared constant. Used both as the initial value of 165 -- the two-sided running sup-log-sum (since @K^+_0 + K^-_0 = 2@) and 166 -- as the tight upper-bound slack in the fast-path skip inside 167 -- 'Numeric.Eproc.Bounded.update' / 168 -- 'Numeric.Eproc.Bernoulli.TwoSided.update'. 169 log2_dbl :: Double 170 log2_dbl = log 2 171 {-# INLINE log2_dbl #-} 172 173 -- | Per-bettor state. One constructor per 'Bettor' alternative; the 174 -- constructor used in any given state matches the 'Bettor' chosen 175 -- in the enclosing 'Config'. 176 -- 177 -- Internal: exposed only so that the per-test 'State' types in 178 -- "Numeric.Eproc.Bounded" and "Numeric.Eproc.Bernoulli" can share 179 -- one implementation. 180 data BetState = 181 SFixed 182 | SAdaptive 183 {-# UNPACK #-} !Double -- sum of z (centred observation) 184 {-# UNPACK #-} !Double -- sum of z^2 (for online variance) 185 {-# UNPACK #-} !Int -- count 186 | SNewton 187 {-# UNPACK #-} !Double -- current bet lambda 188 {-# UNPACK #-} !Double -- running sum of per-step squared gradients 189 190 -- | Per-bettor initial state. 191 init_bet :: Bettor -> BetState 192 init_bet b = case b of 193 Fixed _ -> SFixed 194 Adaptive -> SAdaptive 0 0 0 195 Newton -> SNewton 0 1.0e-6 -- small acc seed avoids div-by-zero 196 {-# INLINE init_bet #-} 197 198 -- | WSR (2024) Algorithm 2 ONS learning rate, @2 \/ (2 - log 3)@. 199 ons_lr :: Double 200 ons_lr = 2 / (2 - log 3) 201 {-# INLINE ons_lr #-} 202 203 -- | Compute the next bet 'lambda' from the bettor and its current 204 -- state; 'lam_max' is the direction-specific safety bound. All 205 -- strategies clip the result to @[0, lam_max]@ so the wealth 206 -- factor stays nonnegative. 207 bet_lambda :: Bettor -> Double -> BetState -> Double 208 bet_lambda b !lam_max !s = case b of 209 Fixed lam -> max 0 (min lam_max lam) 210 Adaptive -> case s of 211 SAdaptive !sm !sm2 !n 212 | n == 0 -> 0 213 | otherwise -> 214 let !nd = fromIntegral n 215 !mu = sm / nd 216 !mu2 = mu * mu 217 !var = max 0 (sm2 / nd - mu2) 218 !den = var + mu2 219 !raw = if den == 0 then 0 else mu / den 220 in max 0 (min lam_max raw) 221 _ -> 0 222 Newton -> case s of 223 SNewton !lam _ -> lam 224 _ -> 0 225 {-# INLINE bet_lambda #-} 226 227 -- | Update bettor state with newly observed centred value 'z'. For 228 -- 'Adaptive' this is just accumulating sums; for 'Newton' we take 229 -- one online Newton step (with the WSR learning rate) on the 230 -- per-step log-wealth loss @-log(1 + lambda * z)@, accumulating 231 -- squared gradients for adaptive scaling. 232 step_bet :: Bettor -> Double -> BetState -> Double -> BetState 233 step_bet b !lam_max !s !z = case b of 234 Fixed _ -> SFixed 235 Adaptive -> case s of 236 SAdaptive !sm !sm2 !n -> SAdaptive (sm + z) (sm2 + z * z) (n + 1) 237 _ -> SAdaptive z (z * z) 1 238 Newton -> case s of 239 SNewton !lam !acc -> 240 let !denom = 1 + lam * z 241 !g = if denom == 0 then 0 else negate z / denom 242 !acc' = acc + g * g 243 !lam' = lam - ons_lr * g / acc' 244 !clp = max 0 (min lam_max lam') 245 in SNewton clp acc' 246 _ -> SNewton 0 1.0e-6 247 {-# INLINE step_bet #-}