eproc

commit 4eddb4d8cf371b4fb2196183b3fca241021544bd
parent 0db7982a791fbcb5d61bb0d8f208a575c2780871
Author: Jared Tobin <jared@jtobin.io>
Date:   Thu,  2 Jul 2026 16:23:35 -0230

bench: add TwoSided groups

Adds 'Bernoulli.TwoSided.update (one step)' and
'Bernoulli.TwoSided.update (1000-sample fold)' to both the
criterion and weigh benchmark suites (fixed / adaptive / newton
each), plus the NFData orphan for 'BernTS.State'. Cost is
roughly 2x the one-sided variant, matching the shape of the
work (two per-direction bettors + log-sum-exp).

Diffstat:
M
bench/Main.hs
 | 
31
+++++++++++++++++++++++++++++++
M
bench/Weight.hs
 | 
29
+++++++++++++++++++++++++++++

2 files changed, 60 insertions(+), 0 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -5,6 +5,7 @@ module Main where
 
 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 @@ import Criterion.Main
 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 @@ main = defaultMain [
   , twosample
   , bern_update
   , bern_stream
+  , bern_ts_update
+  , bern_ts_stream
   ]
 
 update :: Benchmark
@@ -108,3 +112,30 @@ bern_stream =
         , 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
+        ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -5,6 +5,7 @@ module Main where
 
 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 @@ import Weigh
 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 @@ main = mainWith $ do
   twosample
   bern_update
   bern_stream
+  bern_ts_update
+  bern_ts_stream
 
 update :: Weigh ()
 update =
@@ -97,3 +101,28 @@ bern_stream =
         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