Main.hs (6939B)
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 Numeric.Eproc.Bernoulli as Bern 8 import qualified Numeric.Eproc.Bernoulli.TwoSided as BernTS 9 import qualified Numeric.Eproc.Bounded as Bounded 10 import qualified Numeric.Eproc.ConfSeq as CS 11 import qualified Numeric.Eproc.Mixture as Mix 12 import qualified Numeric.Eproc.Paired as P 13 import Criterion.Main 14 15 -- all relevant fields are strict (and UNPACK'd for the doubles), so 16 -- WHNF == NF for these types. orphan instances keep the library API 17 -- untouched. 18 instance NFData Bounded.State where rnf !_ = () 19 instance NFData P.State where rnf !_ = () 20 instance NFData Bern.State where rnf !_ = () 21 instance NFData BernTS.State where rnf !_ = () 22 instance NFData Mix.State where rnf !_ = () 23 instance NFData Bounded.Verdict where rnf !_ = () 24 25 -- partial helper for benches: configs here are hardcoded valid, so a 26 -- 'Left' would be a bench-suite bug. 27 ok :: Either e a -> a 28 ok (Right x) = x 29 ok (Left _) = error "bench: invalid config" 30 31 main :: IO () 32 main = defaultMain [ 33 update 34 , decide 35 , stream 36 , twosample 37 , bern_update 38 , bern_stream 39 , bern_ts_update 40 , bern_ts_stream 41 , mix_update 42 , mix_stream 43 , confseq_update 44 , confseq_stream 45 ] 46 47 update :: Benchmark 48 update = 49 let !cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5)) 50 !cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive) 51 !cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton) 52 !st_f = Bounded.initial cfg_f 53 !st_a = Bounded.initial cfg_a 54 !st_o = Bounded.initial cfg_o 55 !x = 0.7 56 in bgroup "Bounded.update (one step)" [ 57 bench "fixed" $ nf (Bounded.update cfg_f st_f) x 58 , bench "adaptive" $ nf (Bounded.update cfg_a st_a) x 59 , bench "newton" $ nf (Bounded.update cfg_o st_o) x 60 ] 61 62 decide :: Benchmark 63 decide = 64 let !cfg = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton) 65 !st = Bounded.initial cfg 66 in bgroup "Bounded.decide" [ 67 bench "initial state" $ nf (Bounded.decide cfg) st 68 ] 69 70 stream :: Benchmark 71 stream = 72 let !xs = force (take 1000 (cycle [0.3, 0.7])) 73 !cfg_f = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5)) 74 !cfg_a = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Adaptive) 75 !cfg_o = ok (Bounded.config 0.5 0.0 1.0 1.0e-3 Bounded.Newton) 76 run_m cfg = foldl' (Bounded.update cfg) (Bounded.initial cfg) 77 in bgroup "Bounded.update (1000-sample fold)" [ 78 bench "fixed" $ nf (run_m cfg_f) xs 79 , bench "adaptive" $ nf (run_m cfg_a) xs 80 , bench "newton" $ nf (run_m cfg_o) xs 81 ] 82 83 twosample :: Benchmark 84 twosample = 85 let !ps = force (take 1000 (cycle [(0.3, 0.7), (0.7, 0.3)])) 86 !cfg_f = ok (P.config 0.0 1.0 1.0e-3 (Bounded.Fixed 0.5)) 87 !cfg_a = ok (P.config 0.0 1.0 1.0e-3 Bounded.Adaptive) 88 !cfg_o = ok (P.config 0.0 1.0 1.0e-3 Bounded.Newton) 89 run_t cfg = foldl' (P.update cfg) (P.initial cfg) 90 in bgroup "Paired.update (1000-sample fold)" [ 91 bench "fixed" $ nf (run_t cfg_f) ps 92 , bench "adaptive" $ nf (run_t cfg_a) ps 93 , bench "newton" $ nf (run_t cfg_o) ps 94 ] 95 96 bern_update :: Benchmark 97 bern_update = 98 let !cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0)) 99 !cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive) 100 !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton) 101 !st_f = Bern.initial cfg_f 102 !st_a = Bern.initial cfg_a 103 !st_o = Bern.initial cfg_o 104 in bgroup "Bernoulli.update (one step)" [ 105 bench "fixed" $ nf (Bern.update cfg_f st_f) True 106 , bench "adaptive" $ nf (Bern.update cfg_a st_a) True 107 , bench "newton" $ nf (Bern.update cfg_o st_o) True 108 ] 109 110 bern_stream :: Benchmark 111 bern_stream = 112 let !xs = force (take 1000 (cycle [True, False])) 113 !cfg_f = ok (Bern.config 0.05 1.0e-3 (Bern.Fixed 5.0)) 114 !cfg_a = ok (Bern.config 0.05 1.0e-3 Bern.Adaptive) 115 !cfg_o = ok (Bern.config 0.05 1.0e-3 Bern.Newton) 116 run_b cfg = foldl' (Bern.update cfg) (Bern.initial cfg) 117 in bgroup "Bernoulli.update (1000-sample fold)" [ 118 bench "fixed" $ nf (run_b cfg_f) xs 119 , bench "adaptive" $ nf (run_b cfg_a) xs 120 , bench "newton" $ nf (run_b cfg_o) xs 121 ] 122 123 bern_ts_update :: Benchmark 124 bern_ts_update = 125 let !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0)) 126 !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive) 127 !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton) 128 !st_f = BernTS.initial cfg_f 129 !st_a = BernTS.initial cfg_a 130 !st_o = BernTS.initial cfg_o 131 in bgroup "Bernoulli.TwoSided.update (one step)" [ 132 bench "fixed" $ nf (BernTS.update cfg_f st_f) True 133 , bench "adaptive" $ nf (BernTS.update cfg_a st_a) True 134 , bench "newton" $ nf (BernTS.update cfg_o st_o) True 135 ] 136 137 bern_ts_stream :: Benchmark 138 bern_ts_stream = 139 let !xs = force (take 1000 (cycle [True, False])) 140 !cfg_f = ok (BernTS.config 0.5 1.0e-3 (BernTS.Fixed 1.0)) 141 !cfg_a = ok (BernTS.config 0.5 1.0e-3 BernTS.Adaptive) 142 !cfg_o = ok (BernTS.config 0.5 1.0e-3 BernTS.Newton) 143 run_b cfg = foldl' (BernTS.update cfg) (BernTS.initial cfg) 144 in bgroup "Bernoulli.TwoSided.update (1000-sample fold)" [ 145 bench "fixed" $ nf (run_b cfg_f) xs 146 , bench "adaptive" $ nf (run_b cfg_a) xs 147 , bench "newton" $ nf (run_b cfg_o) xs 148 ] 149 150 mix_update :: Benchmark 151 mix_update = 152 let !cfg = ok (Mix.config 4 1.0e-3) 153 !st = Mix.initial cfg 154 !v = force [0.1, -0.2, 0.3, 0.0] 155 in bgroup "Mixture.update (one step)" [ 156 bench "K=4" $ nf (Mix.update cfg st) v 157 ] 158 159 mix_stream :: Benchmark 160 mix_stream = 161 let !vs = force (take 1000 (cycle 162 [[0.1, -0.2, 0.3, 0.0], [-0.3, 0.2, 0.0, 0.1]])) 163 !cfg = ok (Mix.config 4 1.0e-3) 164 run_x c = foldl' (Mix.update c) (Mix.initial c) 165 in bgroup "Mixture.update (1000-step fold)" [ 166 bench "K=4" $ nf (run_x cfg) vs 167 ] 168 169 -- ConfSeq.State carries a list of live grid candidates rather than 170 -- only unboxed fields, but 'initial' and 'update' construct that 171 -- list fully forced, so WHNF == NF holds here by construction too. 172 instance NFData CS.State where rnf !_ = () 173 174 confseq_update :: Benchmark 175 confseq_update = 176 let !cfg = ok (CS.config 0.0 1.0 0.05 200) 177 !st = CS.initial cfg 178 !x = 0.7 179 in bgroup "ConfSeq.update (one step, g = 200)" [ 180 bench "plug-in" $ nf (CS.update cfg st) x 181 ] 182 183 confseq_stream :: Benchmark 184 confseq_stream = 185 let !xs = force (take 1000 (cycle [0.3, 0.7])) 186 !cfg = ok (CS.config 0.0 1.0 0.05 200) 187 run_c = foldl' (CS.update cfg) (CS.initial cfg) 188 in bgroup "ConfSeq.update (1000-sample fold, g = 200)" [ 189 bench "plug-in" $ nf run_c xs 190 ]