commit f1318f8b4511eae8fe5cbe9af2ab6b988c091dd2
parent f47c6310e1bc44f8a0213beeac799ec75cc4d2b6
Author: Jared Tobin <jared@jtobin.io>
Date: Tue, 2 Jun 2026 20:47:24 -0230
bench: add suite
Diffstat:
| A | bench/Main.hs | | | 86 | +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| A | bench/Weight.hs | | | 78 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ |
| M | ppad-eproc.cabal | | | 34 | ++++++++++++++++++++++++++++++++++ |
3 files changed, 198 insertions(+), 0 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -0,0 +1,86 @@
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import Control.DeepSeq
+import qualified Statistics.EProcess as E
+import qualified Statistics.EProcess.Bettor as B
+import qualified Statistics.EProcess.Mean as M
+import qualified Statistics.EProcess.TwoSample as TS
+import Criterion.Main
+
+-- all relevant fields are strict (and UNPACK'd for the doubles), so
+-- WHNF == NF for these types. orphan instances keep the library API
+-- untouched.
+instance NFData B.AGRAPA where rnf !_ = ()
+instance NFData B.ONS where rnf !_ = ()
+instance NFData (M.State s) where rnf !_ = ()
+instance NFData (TS.State s) where rnf !_ = ()
+instance NFData M.Verdict where rnf !_ = ()
+
+main :: IO ()
+main = defaultMain [
+ update
+ , decide
+ , stream
+ , twosample
+ ]
+
+update :: Benchmark
+update =
+ let !cfgF = M.config 0.5 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: M.Config ()
+ !cfgA = M.config 0.5 0.0 1.0 1.0e-3 E.agrapa
+ :: M.Config B.AGRAPA
+ !cfgO = M.config 0.5 0.0 1.0 1.0e-3 E.ons
+ :: M.Config B.ONS
+ !stF = M.initial cfgF
+ !stA = M.initial cfgA
+ !stO = M.initial cfgO
+ !x = 0.7
+ in bgroup "Mean.update (one step)" [
+ bench "fixed" $ nf (M.update cfgF stF) x
+ , bench "agrapa" $ nf (M.update cfgA stA) x
+ , bench "ons" $ nf (M.update cfgO stO) x
+ ]
+
+decide :: Benchmark
+decide =
+ let !cfg = M.config 0.5 0.0 1.0 1.0e-3 E.ons :: M.Config B.ONS
+ !st = M.initial cfg
+ in bgroup "Mean.decide" [
+ bench "initial state" $ nf (M.decide cfg) st
+ ]
+
+stream :: Benchmark
+stream =
+ let !xs = force (take 1000 (cycle [0.3, 0.7]))
+ !cfgF = M.config 0.5 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: M.Config ()
+ !cfgA = M.config 0.5 0.0 1.0 1.0e-3 E.agrapa
+ :: M.Config B.AGRAPA
+ !cfgO = M.config 0.5 0.0 1.0 1.0e-3 E.ons
+ :: M.Config B.ONS
+ runM cfg = foldl' (M.update cfg) (M.initial cfg)
+ in bgroup "Mean.update (1000-sample fold)" [
+ bench "fixed" $ nf (runM cfgF) xs
+ , bench "agrapa" $ nf (runM cfgA) xs
+ , bench "ons" $ nf (runM cfgO) xs
+ ]
+
+twosample :: Benchmark
+twosample =
+ let !ps = force (take 1000 (cycle [(0.3, 0.7), (0.7, 0.3)]))
+ !cfgF = TS.config 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: TS.Config ()
+ !cfgA = TS.config 0.0 1.0 1.0e-3 E.agrapa
+ :: TS.Config B.AGRAPA
+ !cfgO = TS.config 0.0 1.0 1.0e-3 E.ons
+ :: TS.Config B.ONS
+ runT cfg = foldl' (TS.update cfg) (TS.initial cfg)
+ in bgroup "TwoSample.update (1000-sample fold)" [
+ bench "fixed" $ nf (runT cfgF) ps
+ , bench "agrapa" $ nf (runT cfgA) ps
+ , bench "ons" $ nf (runT cfgO) ps
+ ]
diff --git a/bench/Weight.hs b/bench/Weight.hs
@@ -0,0 +1,78 @@
+{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}
+{-# LANGUAGE BangPatterns #-}
+
+module Main where
+
+import Control.DeepSeq
+import qualified Statistics.EProcess as E
+import qualified Statistics.EProcess.Bettor as B
+import qualified Statistics.EProcess.Mean as M
+import qualified Statistics.EProcess.TwoSample as TS
+import Weigh
+
+instance NFData B.AGRAPA where rnf !_ = ()
+instance NFData B.ONS where rnf !_ = ()
+instance NFData (M.State s) where rnf !_ = ()
+instance NFData (TS.State s) where rnf !_ = ()
+instance NFData M.Verdict where rnf !_ = ()
+
+-- note that 'weigh' doesn't work properly in a repl
+main :: IO ()
+main = mainWith $ do
+ update
+ decide
+ stream
+ twosample
+
+update :: Weigh ()
+update =
+ let !cfgF = M.config 0.5 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: M.Config ()
+ !cfgA = M.config 0.5 0.0 1.0 1.0e-3 E.agrapa
+ :: M.Config B.AGRAPA
+ !cfgO = M.config 0.5 0.0 1.0 1.0e-3 E.ons
+ :: M.Config B.ONS
+ !stF = M.initial cfgF
+ !stA = M.initial cfgA
+ !stO = M.initial cfgO
+ in wgroup "Mean.update (one step)" $ do
+ func "fixed" (M.update cfgF stF) 0.7
+ func "agrapa" (M.update cfgA stA) 0.7
+ func "ons" (M.update cfgO stO) 0.7
+
+decide :: Weigh ()
+decide =
+ let !cfg = M.config 0.5 0.0 1.0 1.0e-3 E.ons :: M.Config B.ONS
+ !st = M.initial cfg
+ in wgroup "Mean.decide" $ do
+ func "initial state" (M.decide cfg) st
+
+stream :: Weigh ()
+stream =
+ let !xs = force (take 1000 (cycle [0.3, 0.7]))
+ !cfgF = M.config 0.5 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: M.Config ()
+ !cfgA = M.config 0.5 0.0 1.0 1.0e-3 E.agrapa
+ :: M.Config B.AGRAPA
+ !cfgO = M.config 0.5 0.0 1.0 1.0e-3 E.ons
+ :: M.Config B.ONS
+ runM cfg = foldl' (M.update cfg) (M.initial cfg)
+ in wgroup "Mean.update (1000-sample fold)" $ do
+ func "fixed" (runM cfgF) xs
+ func "agrapa" (runM cfgA) xs
+ func "ons" (runM cfgO) xs
+
+twosample :: Weigh ()
+twosample =
+ let !ps = force (take 1000 (cycle [(0.3, 0.7), (0.7, 0.3)]))
+ !cfgF = TS.config 0.0 1.0 1.0e-3 (const (E.fixed 0.5))
+ :: TS.Config ()
+ !cfgA = TS.config 0.0 1.0 1.0e-3 E.agrapa
+ :: TS.Config B.AGRAPA
+ !cfgO = TS.config 0.0 1.0 1.0e-3 E.ons
+ :: TS.Config B.ONS
+ runT cfg = foldl' (TS.update cfg) (TS.initial cfg)
+ in wgroup "TwoSample.update (1000-sample fold)" $ do
+ func "fixed" (runT cfgF) ps
+ func "agrapa" (runT cfgA) ps
+ func "ons" (runT cfgO) ps
diff --git a/ppad-eproc.cabal b/ppad-eproc.cabal
@@ -56,3 +56,37 @@ test-suite eproc-tests
, tasty
, tasty-hunit
, tasty-quickcheck
+
+benchmark eproc-bench
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: bench
+ main-is: Main.hs
+
+ ghc-options:
+ -rtsopts -O2 -Wall -fno-warn-orphans
+ if flag(llvm)
+ ghc-options: -fllvm
+
+ build-depends:
+ base
+ , criterion
+ , deepseq
+ , ppad-eproc
+
+benchmark eproc-weigh
+ type: exitcode-stdio-1.0
+ default-language: Haskell2010
+ hs-source-dirs: bench
+ main-is: Weight.hs
+
+ ghc-options:
+ -rtsopts -O2 -Wall -fno-warn-orphans
+ if flag(llvm)
+ ghc-options: -fllvm
+
+ build-depends:
+ base
+ , deepseq
+ , ppad-eproc
+ , weigh
