{-# 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
  , log_wealth_sup
  , log_evalue
  , log_evalue_sup
  , p_value
  , 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 :: Double -> Double -> Bettor -> Either ConfigError Config
config !Double
p0 !Double
alpha Bettor
b
  -- NaN comparisons return False and (-Inf, +Inf) fail the range
  -- check, so this catches non-finite p_0 without a separate guard.
  | Bool -> Bool
not (Double
p0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 Bool -> Bool -> Bool
&& Double
p0 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1) = ConfigError -> Either ConfigError Config
forall a b. a -> Either a b
Left (Double -> ConfigError
InvalidBaselineRate Double
p0)
  | Bool
otherwise              = (Config -> Config)
-> Either ConfigError Config -> Either ConfigError Config
forall a b.
(a -> b) -> Either ConfigError a -> Either ConfigError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Config -> Config
Config (Double
-> Double
-> Double
-> Double
-> Bettor
-> Either ConfigError Config
Bounded.config Double
p0 Double
0 Double
1 Double
alpha Bettor
b)
{-# INLINE config #-}

-- | The initial 'State' for a fresh streaming test.
--
--   >>> let s0 = initial cfg
initial :: Config -> State
initial :: Config -> State
initial (Config Config
c) = State -> State
State (Config -> State
Bounded.initial Config
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 -> State -> Bool -> State
update (Config Config
c) (State State
s) !Bool
x =
  State -> State
State (Config -> State -> Double -> State
Bounded.update Config
c State
s (if Bool
x then Double
1 else Double
0))
{-# INLINE update #-}

-- | Compute the current 'Verdict' from the running 'State'.
--
--   >>> decide cfg s0
--   Continue
decide :: Config -> State -> Verdict
decide :: Config -> State -> Verdict
decide (Config Config
c) (State State
s) = Config -> State -> Verdict
Bounded.decide Config
c State
s
{-# INLINE decide #-}

-- inspection -----------------------------------------------------------------

-- | 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
log_wealth :: State -> Double
log_wealth :: State -> Double
log_wealth (State State
s) = State -> Double
Bounded.log_wealth State
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 -> Double
log_wealth_sup (State State
s) = State -> Double
Bounded.log_wealth_sup State
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 -> Double
log_evalue (State State
s) = State -> Double
Bounded.log_evalue State
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 -> Double
log_evalue_sup (State State
s) = State -> Double
Bounded.log_evalue_sup State
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 -> Double
p_value (State State
s) = State -> Double
Bounded.p_value State
s
{-# INLINE p_value #-}

-- | The number of samples consumed so far.
--
--   >>> samples s0
--   0
samples :: State -> Int
samples :: State -> Int
samples (State State
s) = State -> Int
Bounded.samples State
s
{-# INLINE samples #-}