ppad-eproc-0.5.1: bench/Main.hs
{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-type-defaults #-}
{-# LANGUAGE BangPatterns #-}
module Main where
import Control.DeepSeq
import qualified Data.List as L
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 = L.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 = L.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 = L.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 = L.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 = L.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 = L.foldl' (CS.update cfg) (CS.initial cfg)
in bgroup "ConfSeq.update (1000-sample fold, g = 200)" [
bench "plug-in" $ nf run_c xs
]