sampling

commit 7ce815a74a5a4933859dd2bc5b9d4b4a85b9537d
parent 758f91929c590b14a334f5e3e132205b441d26df
Author: Jared Tobin <jared@jtobin.ca>
Date:   Mon,  8 Feb 2016 21:53:04 +1300

Add benchmark skeleton.

Diffstat:
A
bench/Main.hs
 | 
19
+++++++++++++++++++
M
lib/Numeric/Sampling.hs
 | 
6
++++++
M
sampling.cabal
 | 
6
++++--
D
src/Main.hs
 | 
11
-----------

4 files changed, 29 insertions(+), 13 deletions(-)
diff --git a/bench/Main.hs b/bench/Main.hs
@@ -0,0 +1,19 @@
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+module Main where
+
+import Criterion.Main
+import Numeric.Sampling (sampleIO, resampleIO)
+
+setupEnv :: IO [Int]
+setupEnv = return [1..1000000]
+
+main :: IO ()
+main = defaultMain [
+  env setupEnv $ \x ->
+      bgroup "small" [
+        bench "sample" $ nfIO (sampleIO 100 x)
+      , bench "resample" $ nfIO (resampleIO 100 x)
+      ]
+    ]
+
diff --git a/lib/Numeric/Sampling.hs b/lib/Numeric/Sampling.hs
@@ -36,12 +36,14 @@ sample
 sample n xs gen
   | n < 0     = return Nothing
   | otherwise = F.foldM (randomN n gen) xs
+{-# INLINABLE sample #-}
 
 -- | (/O(n)/) 'sample' specialized to IO.
 sampleIO :: Foldable f => Int -> f a -> IO (Maybe (Vector a))
 sampleIO n xs = do
   gen <- createSystemRandom
   sample n xs gen
+{-# INLINABLE sampleIO #-}
 
 -- | (/O(n log n)/) Sample uniformly with replacement (bootstrap).
 resample
@@ -50,12 +52,14 @@ resample
 resample n xs = presample n weighted where
   weight   = recip (F.fold F.genericLength xs)
   weighted = zip (repeat weight) (Foldable.toList xs)
+{-# INLINABLE resample #-}
 
 -- | (/O(n log n)/) 'resample' specialized to IO.
 resampleIO :: (Foldable f) => Int -> f a -> IO (Vector a)
 resampleIO n xs = do
   gen <- createSystemRandom
   resample n xs gen
+{-# INLINABLE resampleIO #-}
 
 -- | (/O(n log n)/) Unequal probability resampling.
 presample
@@ -81,10 +85,12 @@ presample n weighted gen
             let pair   = F.fold (F.find ((>= z) . fst)) xs
                 result = snd . fromJust $ pair -- FIXME
             go (V.cons result acc) (pred s)
+{-# INLINABLE presample #-}
 
 -- | (/O(n log n)/) 'presample' specialized to IO.
 presampleIO :: (Foldable f) => Int -> f (Double, a) -> IO (Vector a)
 presampleIO n weighted = do
   gen <- createSystemRandom
   presample n weighted gen
+{-# INLINABLE presampleIO #-}
 
diff --git a/sampling.cabal b/sampling.cabal
@@ -40,13 +40,15 @@ library
     , vector
     , vector-algorithms
 
-executable sample-test
-  hs-source-dirs:    src
+benchmark bench-sampling
+  type: exitcode-stdio-1.0
+  hs-source-dirs:    bench
   Main-is:           Main.hs
   default-language:  Haskell2010
   ghc-options:
     -Wall -O2
   build-depends:
       base
+    , criterion
     , sampling
 
diff --git a/src/Main.hs b/src/Main.hs
@@ -1,11 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-type-defaults #-}
-
-module Main where
-
-import Numeric.Sampling (sampleIO, resampleIO)
-
-main :: IO ()
-main = do
-  foo <- resampleIO 100 [1..1000000]
-  print foo
-