eproc

Anytime-valid sequential testing and confidence sequences.
git clone git://git.ppad.tech/eproc.git
Log | Files | Refs | README | LICENSE

Weight.hs (6472B)

      1 {-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}
      2 {-# LANGUAGE BangPatterns #-}
      3 
      4 module Main where
      5 
      6 import Control.DeepSeq
      7 import qualified Data.List as L
      8 import qualified Numeric.Eproc.Bernoulli as Bern
      9 import qualified Numeric.Eproc.Bernoulli.TwoSided as BernTS
     10 import qualified Numeric.Eproc.Bounded as Bounded
     11 import qualified Numeric.Eproc.ConfSeq as CS
     12 import qualified Numeric.Eproc.Mixture as Mix
     13 import qualified Numeric.Eproc.Paired as P
     14 import Weigh
     15 
     16 instance NFData Bounded.State    where rnf !_ = ()
     17 instance NFData P.State          where rnf !_ = ()
     18 instance NFData Bern.State       where rnf !_ = ()
     19 instance NFData BernTS.State     where rnf !_ = ()
     20 instance NFData Mix.State        where rnf !_ = ()
     21 instance NFData Bounded.Verdict  where rnf !_ = ()
     22 
     23 -- partial helper for benches: configs here are hardcoded valid.
     24 ok :: Either e a -> a
     25 ok (Right x) = x
     26 ok (Left _)  = error "weigh: invalid config"
     27 
     28 -- note that 'weigh' doesn't work properly in a repl
     29 main :: IO ()
     30 main = mainWith $ do
     31   update
     32   decide
     33   stream
     34   twosample
     35   bern_update
     36   bern_stream
     37   bern_ts_update
     38   bern_ts_stream
     39   mix_update
     40   mix_stream
     41   confseq_update
     42   confseq_stream
     43 
     44 update :: Weigh ()
     45 update =
     46   let !cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
     47       !cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive)
     48       !cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
     49       !st_f  = Bounded.initial cfg_f
     50       !st_a  = Bounded.initial cfg_a
     51       !st_o  = Bounded.initial cfg_o
     52   in  wgroup "Bounded.update (one step)" $ do
     53         func "fixed"    (Bounded.update cfg_f st_f) 0.7
     54         func "adaptive" (Bounded.update cfg_a st_a) 0.7
     55         func "newton"   (Bounded.update cfg_o st_o) 0.7
     56 
     57 decide :: Weigh ()
     58 decide =
     59   let !cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
     60       !st  = Bounded.initial cfg
     61   in  wgroup "Bounded.decide" $ do
     62         func "initial state" (Bounded.decide cfg) st
     63 
     64 stream :: Weigh ()
     65 stream =
     66   let !xs    = force (take 1000 (cycle [0.3, 0.7]))
     67       !cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
     68       !cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive)
     69       !cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
     70       run_m cfg = L.foldl' (Bounded.update cfg) (Bounded.initial cfg)
     71   in  wgroup "Bounded.update (1000-sample fold)" $ do
     72         func "fixed"    (run_m cfg_f) xs
     73         func "adaptive" (run_m cfg_a) xs
     74         func "newton"   (run_m cfg_o) xs
     75 
     76 twosample :: Weigh ()
     77 twosample =
     78   let !ps    = force (take 1000 (cycle [(0.3, 0.7), (0.7, 0.3)]))
     79       !cfg_f = ok (P.config 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
     80       !cfg_a = ok (P.config 0.0 1.0 1.0e-3 Bounded.Adaptive)
     81       !cfg_o = ok (P.config 0.0 1.0 1.0e-3 Bounded.Newton)
     82       run_t cfg = L.foldl' (P.update cfg) (P.initial cfg)
     83   in  wgroup "Paired.update (1000-sample fold)" $ do
     84         func "fixed"    (run_t cfg_f) ps
     85         func "adaptive" (run_t cfg_a) ps
     86         func "newton"   (run_t cfg_o) ps
     87 
     88 bern_update :: Weigh ()
     89 bern_update =
     90   let !cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0))
     91       !cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive)
     92       !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)
     93       !st_f  = Bern.initial cfg_f
     94       !st_a  = Bern.initial cfg_a
     95       !st_o  = Bern.initial cfg_o
     96   in  wgroup "Bernoulli.update (one step)" $ do
     97         func "fixed"    (Bern.update cfg_f st_f) True
     98         func "adaptive" (Bern.update cfg_a st_a) True
     99         func "newton"   (Bern.update cfg_o st_o) True
    100 
    101 bern_stream :: Weigh ()
    102 bern_stream =
    103   let !xs    = force (take 1000 (cycle [True, False]))
    104       !cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0))
    105       !cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive)
    106       !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)
    107       run_b cfg = L.foldl' (Bern.update cfg) (Bern.initial cfg)
    108   in  wgroup "Bernoulli.update (1000-sample fold)" $ do
    109         func "fixed"    (run_b cfg_f) xs
    110         func "adaptive" (run_b cfg_a) xs
    111         func "newton"   (run_b cfg_o) xs
    112 
    113 bern_ts_update :: Weigh ()
    114 bern_ts_update =
    115   let !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))
    116       !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)
    117       !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)
    118       !st_f  = BernTS.initial cfg_f
    119       !st_a  = BernTS.initial cfg_a
    120       !st_o  = BernTS.initial cfg_o
    121   in  wgroup "Bernoulli.TwoSided.update (one step)" $ do
    122         func "fixed"    (BernTS.update cfg_f st_f) True
    123         func "adaptive" (BernTS.update cfg_a st_a) True
    124         func "newton"   (BernTS.update cfg_o st_o) True
    125 
    126 bern_ts_stream :: Weigh ()
    127 bern_ts_stream =
    128   let !xs    = force (take 1000 (cycle [True, False]))
    129       !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0))
    130       !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive)
    131       !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton)
    132       run_b cfg = L.foldl' (BernTS.update cfg) (BernTS.initial cfg)
    133   in  wgroup "Bernoulli.TwoSided.update (1000-sample fold)" $ do
    134         func "fixed"    (run_b cfg_f) xs
    135         func "adaptive" (run_b cfg_a) xs
    136         func "newton"   (run_b cfg_o) xs
    137 
    138 mix_update :: Weigh ()
    139 mix_update =
    140   let !cfg = ok (Mix.config 4 1.0e-3)
    141       !st  = Mix.initial cfg
    142       !v   = force [0.1, -0.2, 0.3, 0.0]
    143   in  wgroup "Mixture.update (one step)" $ do
    144         func "K=4" (Mix.update cfg st) v
    145 
    146 mix_stream :: Weigh ()
    147 mix_stream =
    148   let !vs  = force (take 1000 (cycle
    149                [[0.1, -0.2, 0.3, 0.0], [-0.3, 0.2, 0.0, 0.1]]))
    150       !cfg = ok (Mix.config 4 1.0e-3)
    151       run_x c = L.foldl' (Mix.update c) (Mix.initial c)
    152   in  wgroup "Mixture.update (1000-step fold)" $ do
    153         func "K=4" (run_x cfg) vs
    154 
    155 -- ConfSeq.State carries a list of live grid candidates rather than
    156 -- only unboxed fields, but 'initial' and 'update' construct that
    157 -- list fully forced, so WHNF == NF holds here by construction too.
    158 instance NFData CS.State where rnf !_ = ()
    159 
    160 confseq_update :: Weigh ()
    161 confseq_update =
    162   let !cfg = ok (CS.config 0.0 1.0 0.05 200)
    163       !st  = CS.initial cfg
    164   in  wgroup "ConfSeq.update (one step, g = 200)" $ do
    165         func "plug-in" (CS.update cfg st) 0.7
    166 
    167 confseq_stream :: Weigh ()
    168 confseq_stream =
    169   let !xs  = force (take 1000 (cycle [0.3, 0.7]))
    170       !cfg = ok (CS.config 0.0 1.0 0.05 200)
    171       run_c = L.foldl' (CS.update cfg) (CS.initial cfg)
    172   in  wgroup "ConfSeq.update (1000-sample fold, g = 200)" $ do
    173         func "plug-in" run_c xs