Ticket #149: CriterionBench.hs

File CriterionBench.hs, 1.2 KB (added by rizsotto, 4 years ago)

criterion benchmark for the problem

Line 
1{-# LANGUAGE FlexibleInstances #-}
2module Main where
3
4import Criterion.Main
5import Control.Exception (evaluate)
6
7instance Benchmarkable (b -> a) where
8  run f n
9    | n <= 0    = return ()
10    | otherwise = evaluate f >> run f (n-1)
11
12numOccur :: (Num b) => b -> [b] -> b
13numOccur elem =
14    foldr (\x acc -> if x == elem then (acc+1) else acc) 0
15
16playerMostOccur [a] = a
17playerMostOccur (x:xs)
18 | numOccur x (x:xs) > numOccur (playerMostOccur xs) xs = x
19 | otherwise = playerMostOccur xs
20
21playerMostOccur' [a] = a
22playerMostOccur' (x:xs)
23 | numOccur x (x:xs) > numOccur pmo xs = x
24 | otherwise = pmo
25 where pmo = playerMostOccur' xs
26
27somerepeat :: [Int]
28somerepeat = [ (mod x 10) | x <- [0..1000] ]
29
30main = defaultMain
31      [ bench "playerMostOccur"  $ \n -> playerMostOccur  somerepeat
32      , bench "playerMostOccur'" $ \n -> playerMostOccur' somerepeat
33      , bench "playerMostOccur"  $ \n -> playerMostOccur  [0..100]
34      , bench "playerMostOccur'" $ \n -> playerMostOccur' [0..100]
35      , bench "playerMostOccur"  $ \n -> playerMostOccur  [0..1000]
36      , bench "playerMostOccur'" $ \n -> playerMostOccur' [0..1000]
37      , bench "playerMostOccur"  $ \n -> playerMostOccur  [0..10000]
38      , bench "playerMostOccur'" $ \n -> playerMostOccur' [0..10000]
39      ]