Paired.hs (6897B)
1 {-# OPTIONS_HADDOCK prune #-} 2 {-# LANGUAGE BangPatterns #-} 3 4 -- | 5 -- Module: Numeric.Eproc.Paired 6 -- Copyright: (c) 2026 Jared Tobin 7 -- License: MIT 8 -- Maintainer: Jared Tobin <jared@ppad.tech> 9 -- 10 -- Paired two-sample anytime-valid mean-equality test. 11 -- 12 -- For paired observations @(a_t, b_t)@ where both samples lie in 13 -- @[lo, hi]@, tests 14 -- 15 -- @H_0: E[a_t - b_t | F_{t-1}] = 0 for all t@ 16 -- 17 -- against the negation. Here @F_{t-1}@ is the filtration generated 18 -- by everything observed strictly before time @t@; the conditional 19 -- form is what anytime validity actually requires. For i.i.d. pairs 20 -- this reduces to the usual marginal statement @E[a] = E[b]@; for 21 -- adaptively-collected or otherwise non-i.i.d. streams the 22 -- conditional statement is the right thing to think about. 23 -- 24 -- The reduction is straightforward: under @H_0@, the differences 25 -- @d_t = a_t - b_t@ have (conditional) mean zero, and differences 26 -- of @[lo, hi]@ values lie in @[lo - hi, hi - lo]@. So the paired 27 -- test is just the bounded-mean test ("Numeric.Eproc.Bounded") on 28 -- @d_t@ with null mean @0@ and sample bounds @[lo - hi, hi - lo]@. 29 -- 30 -- Pairing is required: independent two-sample testing without 31 -- alignment would need to bet against a richer alternative (the 32 -- joint distribution rather than the marginal difference) and is 33 -- beyond the scope of this module. 34 -- 35 -- == Example 36 -- 37 -- Test @H_0: E[a] = E[b]@ for samples in @[0, 1]@ at level 38 -- @alpha = 1e-3@ against a stream of paired observations where @a@ 39 -- runs systematically higher than @b@: 40 -- 41 -- >>> let Right cfg = config 0.0 1.0 1.0e-3 Newton 42 -- >>> let ps = take 1000 (cycle [(1, 0), (1, 0), (0, 0), (1, 1)]) 43 -- >>> decide cfg (foldl' (update cfg) (initial cfg) ps) 44 -- Reject 45 46 module Numeric.Eproc.Paired ( 47 -- * Test configuration and state 48 Config 49 , State 50 , Verdict(..) 51 , ConfigError(..) 52 53 -- * Bettor strategies 54 , Bettor(..) 55 56 -- * Construction 57 , config 58 , initial 59 60 -- * Streaming 61 , update 62 , decide 63 64 -- * Inspection 65 , log_wealth 66 , log_wealth_sup 67 , log_evalue 68 , log_evalue_sup 69 , p_value 70 , samples 71 ) where 72 73 import qualified Numeric.Eproc.Bounded as Bounded 74 import Numeric.Eproc.Common (Bettor(..), Verdict(..), ConfigError(..)) 75 76 -- types ---------------------------------------------------------------------- 77 78 -- | Paired two-sample test configuration. Build with 'config'. Wraps 79 -- a 'Numeric.Eproc.Bounded.Config' for the underlying 80 -- difference test. 81 newtype Config = Config Bounded.Config 82 83 -- | Streaming paired two-sample test state. Construct with 'initial' 84 -- and fold paired observations through 'update'. 85 newtype State = State Bounded.State 86 87 -- construction --------------------------------------------------------------- 88 89 -- | Build a 'Config' for the paired two-sample test. 90 -- 91 -- Bounds @lo@ and @hi@ are the (shared) bounds on the individual 92 -- @a@ and @b@ samples; the underlying mean test is then configured 93 -- on the differences, which lie in @[lo - hi, hi - lo]@ with null 94 -- mean @0@. 95 -- 96 -- Returns 'Left' with a 'ConfigError' on inputs that would leave 97 -- the mathematical regime: any of @lo@, @hi@, @alpha@ non-finite 98 -- (NaN or infinite); @lo >= hi@; or @alpha@ outside @(0, 1)@. 99 -- 100 -- >>> let Right cfg = config 0.0 1.0 1.0e-3 Newton 101 config 102 :: Double -- ^ sample lower bound @lo@ 103 -> Double -- ^ sample upper bound @hi@ 104 -> Double -- ^ significance level @alpha@ 105 -> Bettor -- ^ bettor strategy 106 -> Either ConfigError Config 107 config !lo !hi !alpha b = 108 let !d = hi - lo 109 in fmap Config (Bounded.config 0 (negate d) d alpha b) 110 {-# INLINE config #-} 111 112 -- | The initial 'State' for a fresh streaming test. 113 -- 114 -- >>> let s0 = initial cfg 115 initial :: Config -> State 116 initial (Config c) = State (Bounded.initial c) 117 {-# INLINE initial #-} 118 119 -- streaming ------------------------------------------------------------------ 120 121 -- | Fold one paired observation @(a, b)@ into the running 'State'. 122 -- 123 -- Equivalent to feeding the difference @a - b@ into the underlying 124 -- bounded-mean test. 125 -- 126 -- /Precondition/: both @a@ and @b@ must lie in the @[lo, hi]@ 127 -- interval given to 'config'. The type-I error guarantee of the 128 -- test depends on this; the function does not check. 129 -- 130 -- >>> let s1 = update cfg s0 (0.3, 0.7) 131 update :: Config -> State -> (Double, Double) -> State 132 update (Config c) (State s) (!a, !b) = 133 State (Bounded.update c s (a - b)) 134 {-# INLINE update #-} 135 136 -- | Compute the current 'Verdict' from the running 'State'. 137 -- 138 -- 'Reject' iff either directional log-wealth of the underlying 139 -- bounded-mean test on the differences has /ever/ crossed 140 -- @log(2 \/ alpha)@. 141 -- 142 -- >>> decide cfg s0 143 -- Continue 144 decide :: Config -> State -> Verdict 145 decide (Config c) (State s) = Bounded.decide c s 146 {-# INLINE decide #-} 147 148 -- inspection ----------------------------------------------------------------- 149 150 -- | The current @log(K^+_t + K^-_t)@ of the underlying bounded-mean 151 -- test on the differences. Not monotone; bounded above by 152 -- 'log_wealth_sup'. Starts at @log 2@. 153 -- 154 -- >>> log_wealth s0 155 -- 0.6931471805599453 156 log_wealth :: State -> Double 157 log_wealth (State s) = Bounded.log_wealth s 158 {-# INLINE log_wealth #-} 159 160 -- | The supremum-so-far of @log(K^+_t + K^-_t)@ from the underlying 161 -- bounded-mean test on the differences. Monotone nondecreasing; 162 -- 'decide' rejects exactly when it crosses @log(2 \/ alpha)@. 163 -- Starts at @log 2@. 164 -- 165 -- >>> log_wealth_sup s0 166 -- 0.6931471805599453 167 log_wealth_sup :: State -> Double 168 log_wealth_sup (State s) = Bounded.log_wealth_sup s 169 {-# INLINE log_wealth_sup #-} 170 171 -- | The current log e-value of the underlying bounded-mean test on 172 -- the differences: 'log_wealth' minus @log 2@, normalized so a 173 -- fresh state sits at @0@. Not monotone; bounded above by 174 -- 'log_evalue_sup'. 175 -- 176 -- >>> log_evalue s0 177 -- 0.0 178 log_evalue :: State -> Double 179 log_evalue (State s) = Bounded.log_evalue s 180 {-# INLINE log_evalue #-} 181 182 -- | The supremum-so-far of the log e-value: 'log_wealth_sup' minus 183 -- @log 2@. Monotone nondecreasing, starting at @0@; 'decide' 184 -- rejects exactly when it crosses @log(1 \/ alpha)@. 185 -- 186 -- >>> log_evalue_sup s0 187 -- 0.0 188 log_evalue_sup :: State -> Double 189 log_evalue_sup (State s) = Bounded.log_evalue_sup s 190 {-# INLINE log_evalue_sup #-} 191 192 -- | The anytime-valid p-value: the reciprocal of the largest 193 -- e-value attained so far. Monotone nonincreasing; under @H_0@, 194 -- @P(exists t: p_t <= alpha) <= alpha@ for every @alpha@ 195 -- simultaneously. 'decide' returns 'Reject' exactly when this 196 -- value has reached the configured @alpha@ or below. 197 -- 198 -- >>> p_value s0 199 -- 1.0 200 p_value :: State -> Double 201 p_value (State s) = Bounded.p_value s 202 {-# INLINE p_value #-} 203 204 -- | The number of paired observations consumed so far. 205 -- 206 -- >>> samples s0 207 -- 0 208 samples :: State -> Int 209 samples (State s) = Bounded.samples s 210 {-# INLINE samples #-}