ppad-eproc-0.4.0: bench/Main.hs
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}
{-# LANGUAGE BangPatterns #-}
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.ConfSeq as CS
import qualified Numeric.Eproc.Mixture as Mix
import qualified Numeric.Eproc.Paired as P
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 Bounded.State where rnf !_ = ()
instance NFData P.State where rnf !_ = ()
instance NFData Bern.State where rnf !_ = ()
instance NFData BernTS.State where rnf !_ = ()
instance NFData Mix.State where rnf !_ = ()
instance NFData Bounded.Verdict where rnf !_ = ()
-- partial helper for benches: configs here are hardcoded valid, so a
-- 'Left' would be a bench-suite bug.
ok :: Either e a -> a
ok (Right x) = x
ok (Left _) = error "bench: invalid config"
main :: IO ()
main = defaultMain [
update
, decide
, stream
, twosample
, bern_update
, bern_stream
, bern_ts_update
, bern_ts_stream
, mix_update
, mix_stream
, confseq_update
, confseq_stream
]
update :: Benchmark
update =
let !cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
!cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive)
!cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
!st_f = Bounded.initial cfg_f
!st_a = Bounded.initial cfg_a
!st_o = Bounded.initial cfg_o
!x = 0.7
in bgroup "Bounded.update (one step)" [
bench "fixed" $ nf (Bounded.update cfg_f st_f) x
, bench "adaptive" $ nf (Bounded.update cfg_a st_a) x
, bench "newton" $ nf (Bounded.update cfg_o st_o) x
]
decide :: Benchmark
decide =
let !cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
!st = Bounded.initial cfg
in bgroup "Bounded.decide" [
bench "initial state" $ nf (Bounded.decide cfg) st
]
stream :: Benchmark
stream =
let !xs = force (take 1000 (cycle [0.3, 0.7]))
!cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
!cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive)
!cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton)
run_m cfg = foldl' (Bounded.update cfg) (Bounded.initial cfg)
in bgroup "Bounded.update (1000-sample fold)" [
bench "fixed" $ nf (run_m cfg_f) xs
, bench "adaptive" $ nf (run_m cfg_a) xs
, bench "newton" $ nf (run_m cfg_o) xs
]
twosample :: Benchmark
twosample =
let !ps = force (take 1000 (cycle [(0.3, 0.7), (0.7, 0.3)]))
!cfg_f = ok (P.config 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5))
!cfg_a = ok (P.config 0.0 1.0 1.0e-3 Bounded.Adaptive)
!cfg_o = ok (P.config 0.0 1.0 1.0e-3 Bounded.Newton)
run_t cfg = foldl' (P.update cfg) (P.initial cfg)
in bgroup "Paired.update (1000-sample fold)" [
bench "fixed" $ nf (run_t cfg_f) ps
, bench "adaptive" $ nf (run_t cfg_a) ps
, bench "newton" $ nf (run_t cfg_o) ps
]
bern_update :: Benchmark
bern_update =
let !cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0))
!cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive)
!cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)
!st_f = Bern.initial cfg_f
!st_a = Bern.initial cfg_a
!st_o = Bern.initial cfg_o
in bgroup "Bernoulli.update (one step)" [
bench "fixed" $ nf (Bern.update cfg_f st_f) True
, bench "adaptive" $ nf (Bern.update cfg_a st_a) True
, bench "newton" $ nf (Bern.update cfg_o st_o) True
]
bern_stream :: Benchmark
bern_stream =
let !xs = force (take 1000 (cycle [True, False]))
!cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0))
!cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive)
!cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton)
run_b cfg = foldl' (Bern.update cfg) (Bern.initial cfg)
in bgroup "Bernoulli.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
]
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
]
mix_update :: Benchmark
mix_update =
let !cfg = ok (Mix.config 4 1.0e-3)
!st = Mix.initial cfg
!v = force [0.1, -0.2, 0.3, 0.0]
in bgroup "Mixture.update (one step)" [
bench "K=4" $ nf (Mix.update cfg st) v
]
mix_stream :: Benchmark
mix_stream =
let !vs = force (take 1000 (cycle
[[0.1, -0.2, 0.3, 0.0], [-0.3, 0.2, 0.0, 0.1]]))
!cfg = ok (Mix.config 4 1.0e-3)
run_x c = foldl' (Mix.update c) (Mix.initial c)
in bgroup "Mixture.update (1000-step fold)" [
bench "K=4" $ nf (run_x cfg) vs
]
-- ConfSeq.State carries a list of live grid candidates rather than
-- only unboxed fields, but 'initial' and 'update' construct that
-- list fully forced, so WHNF == NF holds here by construction too.
instance NFData CS.State where rnf !_ = ()
confseq_update :: Benchmark
confseq_update =
let !cfg = ok (CS.config 0.0 1.0 0.05 200)
!st = CS.initial cfg
!x = 0.7
in bgroup "ConfSeq.update (one step, g = 200)" [
bench "plug-in" $ nf (CS.update cfg st) x
]
confseq_stream :: Benchmark
confseq_stream =
let !xs = force (take 1000 (cycle [0.3, 0.7]))
!cfg = ok (CS.config 0.0 1.0 0.05 200)
run_c = foldl' (CS.update cfg) (CS.initial cfg)
in bgroup "ConfSeq.update (1000-sample fold, g = 200)" [
bench "plug-in" $ nf run_c xs
]