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