Skip to content

Commit 0c6cc1f

Browse files
committed
Switch to tasty-bench and output relative measurements
1 parent 2c8df3e commit 0c6cc1f

File tree

3 files changed

+57
-40
lines changed

3 files changed

+57
-40
lines changed

Report.hs

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -35,13 +35,13 @@ reportFromCsv fp = do
3535
(filter
3636
(not . all (all null))
3737
(groupBy
38-
(on (==) (takeWhile (/= '/') . concat . take 1))
38+
(on (==) (takeWhile (/= '.') . stripAll . concat . take 1))
3939
rows))))
4040
_ -> error "Couldn't parse csv"
4141

4242
format :: [[String]] -> String
4343
format rows =
44-
("## " ++ takeWhile (/= '/') (concat (concat (take 1 (drop 1 rows))))) ++
44+
("## " ++ takeWhile (/= '.') (stripAll (concat (concat (take 1 (drop 1 rows)))))) ++
4545
"\n\n" ++
4646
unlines
4747
[ "|Name|" ++ intercalate "|" scales ++ "|"
@@ -73,15 +73,20 @@ format rows =
7373
let s =
7474
takeWhile
7575
(/= ':')
76-
(dropWhile (== '/') (dropWhile (/= '/') (concat (take 1 row))))
76+
(dropWhile (== '.') (dropWhile (/= '.') (stripAll (concat (take 1 row)))))
7777
in s
7878
rowScale row =
7979
let scale = dropWhile (== ':') (dropWhile (/= ':') (concat (take 1 row)))
8080
in scale
8181

82+
-- | Strip "All." prefix.
83+
stripAll :: String -> String
84+
stripAll = drop 4
85+
86+
-- | Inputs are in picoseconds, so scaling by 1e-12.
8287
float :: [Double] -> Double -> String
83-
float others x = let (scale, ext) = secs (mean others)
84-
in with (x * scale) ext
88+
float others x = let (scale, ext) = secs (mean others * 1e-12)
89+
in with (x * 1e-12 * scale) ext
8590

8691
-- | Convert a number of seconds to a string. The string will consist
8792
-- of four decimal places, followed by a short description of the time

Time.hs

Lines changed: 45 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -5,10 +5,8 @@ module Main (main) where
55

66
import Control.DeepSeq
77
import Control.Exception (evaluate)
8-
import Control.Monad
98
import Control.Monad.ST
10-
import Criterion.Main
11-
import Criterion.Types
9+
import Data.Maybe
1210
import qualified Data.List as L
1311
import qualified Data.DList as D
1412
import qualified Data.Sequence as S
@@ -20,8 +18,12 @@ import qualified Data.Massiv.Array as M
2018
import qualified Data.RRBVector as RRB
2119
import qualified Acc
2220
import qualified GHC.Exts
23-
import System.Directory
21+
import System.Exit
2422
import System.Random
23+
import Test.Tasty.Bench
24+
import Test.Tasty.Ingredients
25+
import Test.Tasty.Options
26+
import Test.Tasty.Runners
2527

2628
data Conser = forall f. NFData (f Int) => Conser String (Int -> IO (f Int)) (Int -> f Int -> f Int)
2729
data Snocer = forall f. NFData (f Int) => Snocer String (Int -> IO (f Int)) (f Int -> Int -> f Int)
@@ -37,12 +39,14 @@ data RemoveByIndex = forall f. NFData (f Int) => RemoveByIndex String (IO (f Int
3739

3840
main :: IO ()
3941
main = do
40-
let fp = "out.csv"
41-
exists <- doesFileExist fp
42-
when exists (removeFile fp)
43-
defaultMainWith
44-
defaultConfig {csvFile = Just fp}
45-
[ bgroup
42+
opts <- parseOptions benchIngredients benchmarks
43+
let opts' = changeOption (Just . fromMaybe (CsvPath "out.csv")) opts
44+
case tryIngredients benchIngredients opts' benchmarks of
45+
Nothing -> exitFailure
46+
Just mb -> mb >>= \b -> if b then exitSuccess else exitFailure
47+
where
48+
benchmarks = bgroup "All"
49+
[ bgroup
4650
"Consing"
4751
(conses
4852
[ Conser "Data.List" sampleList (:)
@@ -54,7 +58,7 @@ main = do
5458
, Conser "Data.RRBVector" sampleRRB (RRB.<|)
5559
, Conser "Data.Acc" sampleAcc Acc.cons
5660
])
57-
, bgroup
61+
, bgroup
5862
"Snocing"
5963
(snocs
6064
[ Snocer "Data.DList" sampleDList D.snoc
@@ -65,7 +69,7 @@ main = do
6569
, Snocer "Data.RRBVector" sampleRRB (RRB.|>)
6670
, Snocer "Data.Acc" sampleAcc (flip Acc.snoc)
6771
])
68-
, bgroup
72+
, bgroup
6973
"Indexing"
7074
(let size = 10005
7175
in indexes
@@ -77,7 +81,7 @@ main = do
7781
, Indexing "Data.Massiv.Array" (sampleMassivUArray size) M.index'
7882
, Indexing "Data.RRBVector" (sampleRRB size) (RRB.!)
7983
])
80-
, bgroup
84+
, bgroup
8185
"Append"
8286
(appends
8387
[ Append "Data.List" sampleList (++) force
@@ -89,7 +93,7 @@ main = do
8993
, Append "Data.RRBVector" sampleRRB (RRB.><) id
9094
, Append "Data.Acc" sampleAcc (<>) id
9195
])
92-
, bgroup
96+
, bgroup
9397
"Length"
9498
(lengths
9599
[ Length "Data.List" sampleList L.length
@@ -102,7 +106,7 @@ main = do
102106
, Length "Data.RRBVector" sampleRRB length
103107
, Length "Data.Acc" sampleAcc length
104108
])
105-
, bgroup
109+
, bgroup
106110
"Stable Sort"
107111
(sorts
108112
[ Sort "Data.List" randomSampleList L.sort
@@ -111,7 +115,7 @@ main = do
111115
, Sort "Data.Vector.Storable" randomSampleSVVector sortSVec
112116
, Sort "Data.Sequence" randomSampleSeq S.sort
113117
])
114-
, bgroup
118+
, bgroup
115119
"Replicate"
116120
(replicators
117121
[ Replicator "Data.List" L.replicate
@@ -122,7 +126,7 @@ main = do
122126
, Replicator "Data.Sequence" S.replicate
123127
, Replicator "Data.RRBVector" RRB.replicate
124128
])
125-
, bgroup
129+
, bgroup
126130
"Min"
127131
(mins
128132
[ Min "Data.List" randomSampleList L.minimum
@@ -135,7 +139,7 @@ main = do
135139
, Min "Data.RRBVector" randomSampleRRB minimum
136140
, Min "Data.Acc" randomSampleAcc minimum
137141
])
138-
, bgroup
142+
, bgroup
139143
"Max"
140144
(maxs
141145
[ Max "Data.List" randomSampleList L.maximum
@@ -148,7 +152,7 @@ main = do
148152
, Max "Data.RRBVector" randomSampleRRB maximum
149153
, Max "Data.Acc" randomSampleAcc maximum
150154
])
151-
, bgroup
155+
, bgroup
152156
"Filter Element"
153157
(let size = 10005
154158
in removeElems
@@ -164,7 +168,7 @@ main = do
164168
SV.filter
165169
, RemoveElement "Data.Sequence" (sampleSeq size) S.filter
166170
])
167-
, bgroup
171+
, bgroup
168172
"Filter By Index"
169173
(let size = 10005
170174
in removeByIndexes
@@ -178,82 +182,89 @@ main = do
178182
(sampleSVVector size)
179183
SV.ifilter
180184
])
181-
]
182-
where
185+
]
186+
187+
bench' groupTitle title i
188+
| title == "Data.Vector"
189+
= bench (title ++ ":" ++ show i)
190+
| otherwise
191+
= bcompare ("$NF == \"Data.Vector:" ++ show i ++ "\" && $(NF-1) == \"" ++ groupTitle ++ "\"")
192+
. bench (title ++ ":" ++ show i)
193+
183194
appends funcs =
184195
[ env
185196
(payload i)
186-
(\p -> bench (title ++ ":" ++ show i) $ whnf (\x -> forcer (func x x)) p)
197+
(\p -> bench' "Append" title i $ whnf (\x -> forcer (func x x)) p)
187198
| i <- [10, 100, 1000, 10000]
188199
, Append title payload func forcer <- funcs
189200
]
190201
conses funcs =
191202
[ env
192203
(sample i)
193-
(\p -> bench (title ++ ":" ++ show i) (whnf (\e -> func e p) 1))
194-
| i <- [10, 100, 1000, 10000]
204+
(\p -> bench' "Consing" title i (whnf (\e -> func e p) 1))
205+
| i <- [10 , 100, 1000, 10000]
195206
, Conser title sample func <- funcs
196207
]
197208
snocs funcs =
198209
[ env
199210
(sample i)
200-
(\p -> bench (title ++ ":" ++ show i) (whnf (\e -> func p e) 1))
211+
(\p -> bench' "Snocing" title i (whnf (\e -> func p e) 1))
201212
| i <- [10, 100, 1000, 10000]
202213
, Snocer title sample func <- funcs
203214
]
204215
replicators funcs =
205-
[ bench (title ++ ":" ++ show i) $ nf (\(x, y) -> func x y) (i, 1234)
216+
[ bench' "Replicate" title i $ nf (\(x, y) -> func x y) (i, 1234)
206217
| i <- [10, 100, 1000, 10000]
207218
, Replicator title func <- funcs
208219
]
209220
indexes funcs =
210221
[ env
211222
payload
212-
(\p -> bench (title ++ ":" ++ show index) $ nf (\x -> func p x) index)
223+
(\p -> bench' "Indexing" title index $ nf (\x -> func p x) index)
213224
| index <- [10, 100, 1000, 10000]
214225
, Indexing title payload func <- funcs
215226
]
216227
lengths funcs =
217228
[ env
218229
(payload len)
219-
(\p -> bench (title ++ ":" ++ (show len)) $ nf (\x -> func x) p)
230+
(\p -> bench' "Length" title len $ nf (\x -> func x) p)
220231
| len <- [10, 100, 1000, 10000]
221232
, Length title payload func <- funcs
222233
]
223234
mins funcs =
224235
[ env
225236
(payload len)
226-
(\p -> bench (title ++ ":" ++ (show len)) $ nf (\x -> func x) p)
237+
(\p -> bench' "Min" title len $ nf (\x -> func x) p)
227238
| len <- [10, 100, 1000, 10000]
228239
, Min title payload func <- funcs
229240
]
230241
maxs funcs =
231242
[ env
232243
(payload len)
233-
(\p -> bench (title ++ ":" ++ (show len)) $ nf (\x -> func x) p)
244+
(\p -> bench' "Max" title len $ nf (\x -> func x) p)
234245
| len <- [10, 100, 1000, 10000]
235246
, Max title payload func <- funcs
236247
]
237248
sorts funcs =
238249
[ env
239250
(payload len)
240-
(\p -> bench (title ++ ":" ++ (show len)) $ nf (\x -> func x) p)
251+
(\p -> bench' "Stable Sort" title len $ nf (\x -> func x) p)
241252
| len <- [10, 100, 1000, 10000]
242253
, Sort title payload func <- funcs
243254
]
244255
removeElems funcs =
245256
[ env
246257
payload
247258
(\p ->
248-
bench (title ++ ":" ++ show relem) $ nf (\x -> func (/= relem) x) p)
259+
bench' "Filter Element" title relem $ nf (\x -> func (/= relem) x) p)
249260
| relem <- [1, 100, 1000, 10000 :: Int]
250261
, RemoveElement title payload func <- funcs
251262
]
252263
removeByIndexes funcs =
253264
[ env
254265
payload
255266
(\p ->
256-
bench (title ++ ":" ++ show relem) $
267+
bench' "Filter By Index" title relem $
257268
nf (\x -> func (\index _ -> index /= relem) x) p)
258269
| relem <- [1, 100, 1000, 10000 :: Int]
259270
, RemoveByIndex title payload func <- funcs

bench.cabal

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@ benchmark time
1515
build-depends: base
1616
, directory
1717
, vector
18-
, criterion
18+
, tasty
19+
, tasty-bench
1920
, deepseq
2021
, containers
2122
, vector-algorithms

0 commit comments

Comments
 (0)