criterion 0.1.2 → 0.1.3
raw patch · 10 files changed
+253/−123 lines, 10 filesdep +mtldep ~Chartdep ~statisticsPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: mtl
Dependency ranges changed: Chart, statistics
API changes (from Hackage documentation)
- Criterion.IO: class NoOp a
- Criterion.IO: instance (NoOp r) => NoOp (a -> r)
- Criterion.IO: instance NoOp (IO a)
+ Criterion.Config: cfgPlotSameAxis :: Config -> Last Bool
+ Criterion.Config: cfgSummaryFile :: Config -> Last String
+ Criterion.IO: instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r)
+ Criterion.IO: instance CritHPrintfType (ConfigM a)
+ Criterion.IO: instance CritHPrintfType (IO a)
+ Criterion.IO: summary :: String -> ConfigM ()
+ Criterion.Monad: doIO :: IO a -> ConfigM a
+ Criterion.Monad: getConfig :: ConfigM Config
+ Criterion.Monad: getConfigItem :: (Config -> a) -> ConfigM a
+ Criterion.Monad: type ConfigM = ReaderT Config IO
+ Criterion.Monad: withConfig :: Config -> ConfigM a -> IO a
- Criterion: runAndAnalyse :: (String -> Bool) -> Config -> Environment -> Benchmark -> IO ()
+ Criterion: runAndAnalyse :: (String -> Bool) -> Environment -> Benchmark -> ConfigM ()
- Criterion: runBenchmark :: (Benchmarkable b) => Config -> Environment -> b -> IO Sample
+ Criterion: runBenchmark :: (Benchmarkable b) => Environment -> b -> ConfigM Sample
- Criterion.Analysis: analyseMean :: Config -> Sample -> Int -> IO Double
+ Criterion.Analysis: analyseMean :: Sample -> Int -> ConfigM Double
- Criterion.Analysis: noteOutliers :: Config -> Outliers -> IO ()
+ Criterion.Analysis: noteOutliers :: Outliers -> ConfigM ()
- Criterion.Config: Config :: Last String -> Last Double -> Last Bool -> MultiMap Plot PlotOutput -> PrintExit -> Last Int -> Last Int -> Last Verbosity -> Config
+ Criterion.Config: Config :: Last String -> Last Double -> Last Bool -> MultiMap Plot PlotOutput -> Last Bool -> PrintExit -> Last Int -> Last Int -> Last String -> Last Verbosity -> Config
- Criterion.Environment: measureEnvironment :: Config -> IO Environment
+ Criterion.Environment: measureEnvironment :: ConfigM Environment
- Criterion.IO: note :: (HPrintfType r, NoOp r) => Config -> String -> r
+ Criterion.IO: note :: (CritHPrintfType r) => String -> r
- Criterion.IO: printError :: (HPrintfType r) => String -> r
+ Criterion.IO: printError :: (CritHPrintfType r) => String -> r
- Criterion.IO: prolix :: (HPrintfType r, NoOp r) => Config -> String -> r
+ Criterion.IO: prolix :: (CritHPrintfType r) => String -> r
- Criterion.Plot: plotKDE :: PlotOutput -> String -> Points -> UArr Double -> IO ()
+ Criterion.Plot: plotKDE :: PlotOutput -> String -> Maybe (Double :*: Double) -> Points -> UArr Double -> IO ()
- Criterion.Plot: plotWith :: Plot -> Config -> (PlotOutput -> IO ()) -> IO ()
+ Criterion.Plot: plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM ()
Files
- Criterion.hs +63/−37
- Criterion/Analysis.hs +12/−13
- Criterion/Config.hs +8/−0
- Criterion/Environment.hs +11/−11
- Criterion/IO.hs +68/−22
- Criterion/Main.hs +19/−10
- Criterion/Monad.hs +28/−0
- Criterion/Plot.hs +24/−20
- criterion.cabal +7/−5
- examples/Fibber.hs +13/−5
Criterion.hs view
@@ -19,17 +19,18 @@ , runAndAnalyse ) where -import Control.Monad (replicateM_, when)+import Control.Monad ((<=<), forM_, replicateM_, when) import Criterion.Analysis (OutlierVariance(..), classifyOutliers, outlierVariance, noteOutliers) import Criterion.Config (Config(..), Plot(..), fromLJ) import Criterion.Environment (Environment(..))-import Criterion.IO (note, prolix)+import Criterion.IO (note, prolix, summary) import Criterion.Measurement (getTime, runForAtLeast, secs, time_)+import Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO) import Criterion.Plot (plotWith, plotKDE, plotTiming) import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, bgroup)-import Data.Array.Vector ((:*:)(..), lengthU, mapU)-import Statistics.Function (createIO)+import Data.Array.Vector ((:*:)(..), concatU, lengthU, mapU)+import Statistics.Function (createIO, minMax) import Statistics.KernelDensity (epanechnikovPDF) import Statistics.RandomVariate (withSystemRandom) import Statistics.Resampling (resample)@@ -37,23 +38,25 @@ import Statistics.Sample (mean, stdDev) import Statistics.Types (Sample) import System.Mem (performGC)+import Text.Printf (printf) -- | Run a single benchmark, and return timings measured when -- executing it.-runBenchmark :: Benchmarkable b => Config -> Environment -> b -> IO Sample-runBenchmark cfg env b = do- runForAtLeast 0.1 10000 (`replicateM_` getTime)+runBenchmark :: Benchmarkable b => Environment -> b -> ConfigM Sample+runBenchmark env b = do+ doIO $ runForAtLeast 0.1 10000 (`replicateM_` getTime) let minTime = envClockResolution env * 1000- (testTime :*: testIters :*: _) <- runForAtLeast (min minTime 0.1) 1 timeLoop- prolix cfg "ran %d iterations in %s\n" testIters (secs testTime)+ (testTime :*: testIters :*: _) <- doIO $ runForAtLeast (min minTime 0.1) 1 timeLoop+ prolix "ran %d iterations in %s\n" testIters (secs testTime)+ cfg <- getConfig let newIters = ceiling $ minTime * testItersD / testTime sampleCount = fromLJ cfgSamples cfg newItersD = fromIntegral newIters testItersD = fromIntegral testIters- note cfg "collecting %d samples, %d iterations each, in estimated %s\n"+ note "collecting %d samples, %d iterations each, in estimated %s\n" sampleCount newIters (secs (fromIntegral sampleCount * newItersD * testTime / testItersD))- times <- fmap (mapU ((/ newItersD) . subtract (envClockCost env))) .+ times <- doIO $ fmap (mapU ((/ newItersD) . subtract (envClockCost env))) . createIO sampleCount . const $ do when (fromLJ cfgPerformGC cfg) $ performGC time_ (timeLoop newIters)@@ -63,19 +66,17 @@ | otherwise = run b k >> timeLoop (k-1) -- | Run a single benchmark and analyse its performance.-runAndAnalyseOne :: Benchmarkable b => Config -> Environment -> String -> b- -> IO ()-runAndAnalyseOne cfg env desc b = do- times <- runBenchmark cfg env b+runAndAnalyseOne :: Benchmarkable b => Environment -> String -> b+ -> ConfigM Sample+runAndAnalyseOne env _desc b = do+ times <- runBenchmark env b let numSamples = lengthU times- plotWith Timing cfg $ \o -> plotTiming o desc times- plotWith KernelDensity cfg $ \o -> uncurry (plotKDE o desc)- (epanechnikovPDF 100 times) let ests = [mean,stdDev]- numResamples = fromLJ cfgResamples cfg- note cfg "bootstrapping with %d resamples\n" numResamples- res <- withSystemRandom (\gen -> resample gen ests numResamples times)- let [em,es] = bootstrapBCA (fromLJ cfgConfInterval cfg) times ests res+ numResamples <- getConfigItem $ fromLJ cfgResamples+ note "bootstrapping with %d resamples\n" numResamples+ res <- doIO $ withSystemRandom (\gen -> resample gen ests numResamples times)+ ci <- getConfigItem $ fromLJ cfgConfInterval+ let [em,es] = bootstrapBCA ci times ests res (effect, v) = outlierVariance em es (fromIntegral $ numSamples) wibble = case effect of Unaffected -> "unaffected" :: String@@ -83,30 +84,55 @@ Moderate -> "moderately inflated" Severe -> "severely inflated" bs "mean" em+ summary "," bs "std dev" es- noteOutliers cfg (classifyOutliers times)- note cfg "variance introduced by outliers: %.3f%%\n" (v * 100)- note cfg "variance is %s by outliers\n" wibble- where bs :: String -> Estimate -> IO ()- bs d e = note cfg "%s: %s, lb %s, ub %s, ci %.3f\n" d- (secs $ estPoint e)- (secs $ estLowerBound e) (secs $ estUpperBound e)- (estConfidenceLevel e)+ summary "\n"+ noteOutliers (classifyOutliers times)+ note "variance introduced by outliers: %.3f%%\n" (v * 100)+ note "variance is %s by outliers\n" wibble+ return times+ where bs :: String -> Estimate -> ConfigM ()+ bs d e = do note "%s: %s, lb %s, ub %s, ci %.3f\n" d+ (secs $ estPoint e)+ (secs $ estLowerBound e) (secs $ estUpperBound e)+ (estConfidenceLevel e)+ summary $ printf "%g,%g,%g" + (estPoint e)+ (estLowerBound e) (estUpperBound e) +plotAll :: [(String, Sample)] -> ConfigM ()+plotAll descTimes = forM_ descTimes $ \(desc,times) -> do+ plotWith Timing $ \o -> plotTiming o desc times+ plotWith KernelDensity $ \o -> uncurry (plotKDE o desc extremes)+ (epanechnikovPDF 100 times)+ where+ extremes = case descTimes of+ (_:_:_) -> toJust . minMax . concatU . map snd $ descTimes+ _ -> Nothing+ toJust r@(lo :*: hi)+ | lo == infinity || hi == -infinity = Nothing+ | otherwise = Just r+ where infinity = 1/0+ -- | Run, and analyse, one or more benchmarks. runAndAnalyse :: (String -> Bool) -- ^ A predicate that chooses -- whether to run a benchmark by its -- name.- -> Config -> Environment -> Benchmark- -> IO ()-runAndAnalyse p cfg env = go ""+ -> ConfigM ()+runAndAnalyse p env = plotAll <=< go "" where go pfx (Benchmark desc b)- | p desc' = do note cfg "\nbenchmarking %s\n" desc'- runAndAnalyseOne cfg env desc' b- | otherwise = return ()+ | p desc' = do note "\nbenchmarking %s\n" desc'+ summary (show desc' ++ ",") -- String will be quoted+ x <- runAndAnalyseOne env desc' b+ sameAxis <- getConfigItem $ fromLJ cfgPlotSameAxis+ if sameAxis+ then return [(desc',x)]+ else plotAll [(desc',x)] >> return []+ | otherwise = return [] where desc' = prefix pfx desc- go pfx (BenchGroup desc bs) = mapM_ (go (prefix pfx desc)) bs+ go pfx (BenchGroup desc bs) =+ concat `fmap` mapM (go (prefix pfx desc)) bs prefix "" desc = desc prefix pfx desc = pfx ++ '/' : desc
Criterion/Analysis.hs view
@@ -21,9 +21,9 @@ ) where import Control.Monad (when)-import Criterion.Config (Config) import Criterion.IO (note) import Criterion.Measurement (secs)+import Criterion.Monad (ConfigM) import Data.Array.Vector (foldlU) import Data.Int (Int64) import Data.Monoid (Monoid(..))@@ -122,28 +122,27 @@ -- | Display the mean of a 'Sample', and characterise the outliers -- present in the sample.-analyseMean :: Config- -> Sample+analyseMean :: Sample -> Int -- ^ Number of iterations used to -- compute the sample.- -> IO Double-analyseMean cfg a iters = do+ -> ConfigM Double+analyseMean a iters = do let µ = mean a- note cfg "mean is %s (%d iterations)\n" (secs µ) iters- noteOutliers cfg . classifyOutliers $ a+ note "mean is %s (%d iterations)\n" (secs µ) iters+ noteOutliers . classifyOutliers $ a return µ -- | Display a report of the 'Outliers' present in a 'Sample'.-noteOutliers :: Config -> Outliers -> IO ()-noteOutliers cfg o = do+noteOutliers :: Outliers -> ConfigM ()+noteOutliers o = do let frac n = (100::Double) * fromIntegral n / fromIntegral (samplesSeen o)- check :: Int64 -> Double -> String -> IO ()+ check :: Int64 -> Double -> String -> ConfigM () check k t d = when (frac k > t) $- note cfg " %d (%.1g%%) %s\n" k (frac k) d+ note " %d (%.1g%%) %s\n" k (frac k) d outCount = countOutliers o when (outCount > 0) $ do- note cfg "found %d outliers among %d samples (%.1g%%)\n"- outCount (samplesSeen o) (frac outCount)+ note "found %d outliers among %d samples (%.1g%%)\n"+ outCount (samplesSeen o) (frac outCount) check (lowSevere o) 0 "low severe" check (lowMild o) 1 "low mild" check (highMild o) 1 "high mild"
Criterion/Config.hs view
@@ -65,9 +65,11 @@ , cfgConfInterval :: Last Double -- ^ Confidence interval to use. , cfgPerformGC :: Last Bool -- ^ Whether to run the GC between passes. , cfgPlot :: MultiMap Plot PlotOutput -- ^ What to plot, and where.+ , cfgPlotSameAxis :: Last Bool , cfgPrintExit :: PrintExit -- ^ Whether to print information and exit. , cfgResamples :: Last Int -- ^ Number of resamples to perform. , cfgSamples :: Last Int -- ^ Number of samples to collect.+ , cfgSummaryFile :: Last String -- ^ Filename of summary CSV , cfgVerbosity :: Last Verbosity -- ^ Whether to run verbosely. } deriving (Eq, Read, Show, Typeable) @@ -82,9 +84,11 @@ , cfgConfInterval = ljust 0.95 , cfgPerformGC = ljust False , cfgPlot = mempty+ , cfgPlotSameAxis = ljust False , cfgPrintExit = Nada , cfgResamples = ljust (100 * 1000) , cfgSamples = ljust 100+ , cfgSummaryFile = mempty , cfgVerbosity = ljust Normal } @@ -106,9 +110,11 @@ , cfgConfInterval = mempty , cfgPerformGC = mempty , cfgPlot = mempty+ , cfgPlotSameAxis = mempty , cfgPrintExit = mempty , cfgResamples = mempty , cfgSamples = mempty+ , cfgSummaryFile = mempty , cfgVerbosity = mempty } @@ -119,8 +125,10 @@ , cfgConfInterval = app cfgConfInterval a b , cfgPerformGC = app cfgPerformGC a b , cfgPlot = app cfgPlot a b+ , cfgPlotSameAxis = app cfgPlotSameAxis a b , cfgPrintExit = app cfgPrintExit a b , cfgSamples = app cfgSamples a b+ , cfgSummaryFile = app cfgSummaryFile a b , cfgResamples = app cfgResamples a b , cfgVerbosity = app cfgVerbosity a b }
Criterion/Environment.hs view
@@ -19,9 +19,9 @@ import Control.Monad (replicateM_) import Criterion.Analysis (analyseMean)-import Criterion.Config (Config) import Criterion.IO (note) import Criterion.Measurement (getTime, runForAtLeast, time_)+import Criterion.Monad (ConfigM, doIO) import Data.Array.Vector import Data.Typeable (Typeable) import Statistics.Function (createIO)@@ -35,15 +35,15 @@ } deriving (Eq, Read, Show, Typeable) -- | Measure the execution environment.-measureEnvironment :: Config -> IO Environment-measureEnvironment cfg = do- note cfg "warming up\n"- (_ :*: seed :*: _) <- runForAtLeast 0.1 10000 resolution- note cfg "estimating clock resolution...\n"- clockRes <- thd3 `fmap` runForAtLeast 0.5 seed resolution >>=- uncurry (analyseMean cfg)- note cfg "estimating cost of a clock call...\n"- clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry (analyseMean cfg)+measureEnvironment :: ConfigM Environment+measureEnvironment = do+ note "warming up\n"+ (_ :*: seed :*: _) <- doIO $ runForAtLeast 0.1 10000 resolution+ note "estimating clock resolution...\n"+ clockRes <- thd3 `fmap` doIO (runForAtLeast 0.5 seed resolution) >>=+ uncurry analyseMean+ note "estimating cost of a clock call...\n"+ clockCost <- cost (min (100000 * clockRes) 1) >>= uncurry analyseMean return $ Environment { envClockResolution = clockRes , envClockCost = clockCost@@ -53,7 +53,7 @@ times <- createIO (k+1) (const getTime) return (tailU . filterU (>=0) . zipWithU (-) (tailU times) $ times, lengthU times)- cost timeLimit = do+ cost timeLimit = doIO $ do let timeClock k = time_ (replicateM_ k getTime) timeClock 1 (_ :*: iters :*: elapsed) <- runForAtLeast 0.01 10000 timeClock
Criterion/IO.hs view
@@ -9,40 +9,86 @@ -- -- Input and output actions. +{-# LANGUAGE FlexibleInstances, Rank2Types, TypeSynonymInstances #-} module Criterion.IO (- NoOp- , note+ note , printError , prolix+ , summary ) where -import Criterion.Config (Config, Verbosity(..), cfgVerbosity, fromLJ)-import System.IO (stderr, stdout)-import Text.Printf (HPrintfType, hPrintf)+import Control.Monad (when)+import Control.Monad.Trans (liftIO)+import Criterion.Config (Config, Verbosity(..), cfgSummaryFile, cfgVerbosity, fromLJ)+import Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO)+import Data.Monoid (getLast)+import System.IO (Handle, stderr, stdout)+import qualified Text.Printf (HPrintfType, hPrintf)+import Text.Printf (PrintfArg) --- | A typeclass hack to match that of the 'HPrintfType' class.-class NoOp a where- noop :: a+-- First item is the action to print now, given all the arguments gathered+-- together so far. The second item is the function that will take a further argument+-- and give back a new PrintfCont.+data PrintfCont = PrintfCont (IO ()) (PrintfArg a => a -> PrintfCont) -instance NoOp (IO a) where- noop = return undefined+-- An internal class that acts like Printf/HPrintf.+--+-- The implementation is visible to the rest of the program, but the class is+class CritHPrintfType a where+ chPrintfImpl :: (Config -> Bool) -> PrintfCont -> a -instance (NoOp r) => NoOp (a -> r) where- noop _ = noop +instance CritHPrintfType (ConfigM a) where+ chPrintfImpl check (PrintfCont final _)+ = do x <- getConfig+ when (check x) (liftIO final)+ return undefined++instance CritHPrintfType (IO a) where+ chPrintfImpl _ (PrintfCont final _)+ = final >> return undefined++instance (CritHPrintfType r, PrintfArg a) => CritHPrintfType (a -> r) where+ chPrintfImpl check (PrintfCont _ anotherArg) x+ = chPrintfImpl check (anotherArg x)++chPrintf :: CritHPrintfType r => (Config -> Bool) -> Handle -> String -> r+chPrintf shouldPrint h s+ = chPrintfImpl shouldPrint (make (Text.Printf.hPrintf h s) (Text.Printf.hPrintf h s))+ where+ make :: IO () -> (forall a r. (PrintfArg a, Text.Printf.HPrintfType r) => a -> r) -> PrintfCont+ make curCall curCall' = PrintfCont curCall (\x -> make (curCall' x) (curCall' x))++{- A demonstration of how to write printf in this style, in case it is ever needed+ in fututre:++cPrintf :: CritHPrintfType r => (Config -> Bool) -> String -> r+cPrintf shouldPrint s+ = chPrintfImpl shouldPrint (make (Text.Printf.printf s)+ (Text.Printf.printf s))+ where+ make :: IO () -> (forall a r. (PrintfArg a, Text.Printf.PrintfType r) => a -> r) -> PrintfCont+ make curCall curCall' = PrintfCont curCall (\x -> make (curCall' x) (curCall' x))+-}+ -- | Print a \"normal\" note.-note :: (HPrintfType r, NoOp r) => Config -> String -> r-note cfg msg = if fromLJ cfgVerbosity cfg > Quiet- then hPrintf stdout msg- else noop+note :: (CritHPrintfType r) => String -> r+note = chPrintf ((> Quiet) . fromLJ cfgVerbosity) stdout -- | Print verbose output.-prolix :: (HPrintfType r, NoOp r) => Config -> String -> r-prolix cfg msg = if fromLJ cfgVerbosity cfg == Verbose- then hPrintf stdout msg- else noop+prolix :: (CritHPrintfType r) => String -> r+prolix = chPrintf ((== Verbose) . fromLJ cfgVerbosity) stdout -- | Print an error message.-printError :: (HPrintfType r) => String -> r-printError msg = hPrintf stderr msg+printError :: (CritHPrintfType r) => String -> r+printError = chPrintf (const True) stderr++-- | Add to summary CSV (if applicable)+summary :: String -> ConfigM ()+summary msg+ = do sumOpt <- getConfigItem (getLast . cfgSummaryFile)+ case sumOpt of+ Just fn -> doIO $ appendFile fn msg+ Nothing -> return ()+
Criterion/Main.hs view
@@ -41,7 +41,8 @@ import Criterion.Environment (measureEnvironment) import Criterion.IO (note, printError) import Criterion.MultiMap (singleton)-import Criterion.Types (Benchmarkable(..), Benchmark, bench, benchNames, bgroup)+import Criterion.Monad (doIO, withConfig)+import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, benchNames, bgroup) import Data.List (isPrefixOf, sort) import Data.Monoid (Monoid(..), Last(..)) import System.Console.GetOpt@@ -113,10 +114,12 @@ "collect garbage between iterations" , Option ['I'] ["ci"] (ReqArg ci "CI") "bootstrap confidence interval"- , Option ['l'] ["--list"] (noArg mempty { cfgPrintExit = List })+ , Option ['l'] ["list"] (noArg mempty { cfgPrintExit = List }) "print a list of all benchmark names, then exit" , Option ['k'] ["plot-kde"] (ReqArg (plot KernelDensity) "TYPE") "plot kernel density estimate of probabilities"+ , Option [] ["kde-same-axis"] (noArg mempty {cfgPlotSameAxis = ljust True })+ "plot all KDE graphs with the same X axis range (useful for comparison)" , Option ['q'] ["quiet"] (noArg mempty { cfgVerbosity = ljust Quiet }) "print less output" , Option [] ["resamples"]@@ -127,6 +130,8 @@ "number of samples to collect" , Option ['t'] ["plot-timing"] (ReqArg (plot Timing) "TYPE") "plot timings"+ , Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME")+ "produce a summary CSV file of all the benchmark means and standard deviations" , Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version }) "display version, then exit" , Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })@@ -134,10 +139,10 @@ ] printBanner :: Config -> IO ()-printBanner cfg =+printBanner cfg = withConfig cfg $ case cfgBanner cfg of- Last (Just b) -> note cfg "%s\n" b- _ -> note cfg "Hey, nobody told me what version I am!\n"+ Last (Just b) -> note "%s\n" b+ _ -> note "Hey, nobody told me what version I am!\n" printUsage :: [OptDescr (IO Config)] -> ExitCode -> IO a printUsage options exitCode = do@@ -218,14 +223,18 @@ defaultMainWith :: Config -> [Benchmark] -> IO () defaultMainWith defCfg bs = do (cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs- if cfgPrintExit cfg == List+ withConfig cfg $+ if cfgPrintExit cfg == List then do- note cfg "Benchmarks:\n"- mapM_ (note cfg " %s\n") (sort $ concatMap benchNames bs)+ note "Benchmarks:\n"+ mapM_ (note " %s\n") (sort $ concatMap benchNames bs) else do- env <- measureEnvironment cfg+ case getLast $ cfgSummaryFile cfg of+ Just fn -> doIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"+ Nothing -> return ()+ env <- measureEnvironment let shouldRun b = null args || any (`isPrefixOf` b) args- mapM_ (runAndAnalyse shouldRun cfg env) bs+ runAndAnalyse shouldRun env $ BenchGroup "" bs -- | Display an error message from a command line parsing failure, and -- exit.
+ Criterion/Monad.hs view
@@ -0,0 +1,28 @@+-- |+-- Module : Criterion.Monad+-- Copyright : (c) Neil Brown 2009+--+-- License : BSD-style+-- Maintainer : bos@serpentine.com+-- Stability : experimental+-- Portability : GHC+--+module Criterion.Monad (ConfigM, getConfig, getConfigItem, doIO, withConfig) where++import Control.Monad.Reader (ReaderT, ask, runReaderT)+import Control.Monad.Trans (lift)+import Criterion.Config (Config)++type ConfigM = ReaderT Config IO++getConfig :: ConfigM Config+getConfig = ask++getConfigItem :: (Config -> a) -> ConfigM a+getConfigItem f = f `fmap` getConfig++doIO :: IO a -> ConfigM a+doIO = lift++withConfig :: Config -> ConfigM a -> IO a+withConfig = flip runReaderT
Criterion/Plot.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}+{-# LANGUAGE CPP, ScopedTypeVariables, TypeOperators #-} -- | -- Module : Criterion.Plot@@ -19,6 +19,7 @@ ) where import Criterion.Config+import Criterion.Monad (ConfigM, doIO, getConfigItem) import Data.Array.Vector import Data.Char (isSpace, toLower) import Data.Foldable (forM_)@@ -38,11 +39,9 @@ import Criterion.IO (printError) #endif -plotWith :: Plot -> Config -> (PlotOutput -> IO ()) -> IO ()-plotWith p cfg plot =- case M.lookup p (cfgPlot cfg) of- Nothing -> return ()- Just s -> forM_ s $ plot+plotWith :: Plot -> (PlotOutput -> IO ()) -> ConfigM ()+plotWith p plot = getConfigItem (M.lookup p . cfgPlot)+ >>= maybe (return ()) (flip forM_ (doIO . plot)) -- | Plot timing data. plotTiming :: PlotOutput -- ^ The kind of output desired.@@ -80,33 +79,34 @@ -- | Plot kernel density estimate. plotKDE :: PlotOutput -- ^ The kind of output desired. -> String -- ^ Benchmark name.+ -> Maybe (Double :*: Double) -- ^ Range of x-axis -> Points -- ^ Points at which KDE was computed. -> UArr Double -- ^ Kernel density estimates. -> IO () -plotKDE CSV desc points pdf = do+plotKDE CSV desc _exs points pdf = do writeTo (mangle $ printf "%s densities.csv" desc) $ \h -> do putRow h ["execution time", "probability"] forM_ (zip (fromU pdf) (fromU (fromPoints points))) $ \(x, y) -> putRow h [show x, show y] #ifdef HAVE_CHART-plotKDE (PDF x y) desc points pdf =- renderableToPDFFile (renderKDE desc points pdf) x y+plotKDE (PDF x y) desc exs points pdf =+ renderableToPDFFile (renderKDE desc exs points pdf) x y (mangle $ printf "%s densities %dx%d.pdf" desc x y) -plotKDE (PNG x y) desc points pdf =- renderableToPNGFile (renderKDE desc points pdf) x y+plotKDE (PNG x y) desc exs points pdf =+ renderableToPNGFile (renderKDE desc exs points pdf) x y (mangle $ printf "%s densities %dx%d.png" desc x y) -plotKDE (SVG x y) desc points pdf =- renderableToSVGFile (renderKDE desc points pdf) x y+plotKDE (SVG x y) desc exs points pdf =+ renderableToSVGFile (renderKDE desc exs points pdf) x y (mangle $ printf "%s densities %dx%d.svg" desc x y) -plotKDE (Window x y) desc points pdf =- renderableToWindow (renderKDE desc points pdf) x y+plotKDE (Window x y) desc exs points pdf =+ renderableToWindow (renderKDE desc exs points pdf) x y #else-plotKDE output _desc _points _pdf =+plotKDE output _desc _exs _points _pdf = printError "ERROR: output type %s not supported on this platform\n" (show output) #endif@@ -133,8 +133,9 @@ $ plot_bars_spacing ^= BarsFixGap 0 $ defaultPlotBars -renderKDE :: String -> Points -> UArr Double -> Renderable ()-renderKDE desc points pdf = toRenderable layout+renderKDE :: String -> Maybe (Double :*: Double) -> Points -> UArr Double+ -> Renderable ()+renderKDE desc exs points pdf = toRenderable layout where layout = layout1_title ^= "Densities of execution times for \"" ++ desc ++ "\""@@ -146,10 +147,13 @@ leftAxis = laxis_title ^= "estimate of probability density" $ defaultLayoutAxis - bottomAxis = laxis_generate ^= autoScaledAxis secAxis+ bottomAxis = laxis_generate ^= semiAutoScaledAxis secAxis $ laxis_title ^= "execution time" $ defaultLayoutAxis + semiAutoScaledAxis opts ps = autoScaledAxis opts (extremities ++ ps)+ extremities = maybe [] (\(lo :*: hi) -> [lo, hi]) exs+ info = plot_lines_values ^= [zip (fromU (fromPoints points)) (fromU spdf)] $ defaultPlotLines @@ -157,7 +161,7 @@ spdf = mapU (/ sumU pdf) pdf -- | An axis whose labels display as seconds (or fractions thereof).-secAxis :: LinearAxisParams+secAxis :: LinearAxisParams Double secAxis = la_labelf ^= secs $ defaultLinearAxis
criterion.cabal view
@@ -1,12 +1,12 @@ name: criterion-version: 0.1.2-synopsis: Benchmarking, Performance, Testing+version: 0.1.3+synopsis: Robust, reliable performance measurement and analysis license: BSD3 license-file: LICENSE author: Bryan O'Sullivan <bos@serpentine.com> maintainer: Bryan O'Sullivan <bos@serpentine.com> copyright: 2009 Bryan O'Sullivan-category: Development, Performance+category: Development, Performance, Testing build-type: Simple cabal-version: >= 1.2 extra-source-files:@@ -33,6 +33,7 @@ Criterion.IO Criterion.Main Criterion.Measurement+ Criterion.Monad Criterion.MultiMap Criterion.Plot Criterion.Types@@ -42,16 +43,17 @@ bytestring >= 0.9 && < 1.0, containers, filepath,+ mtl, parallel, parsec,- statistics >= 0.3.4,+ statistics >= 0.3.5, time, uvector, uvector-algorithms >= 0.2 if flag(chart) build-depends:- Chart,+ Chart>=0.12, data-accessor cpp-options: -DHAVE_CHART
examples/Fibber.hs view
@@ -3,15 +3,18 @@ import Criterion.Main fib :: Int -> Int-fib 0 = 0-fib 1 = 1-fib n = fib (n-1) + fib (n-2)+fib n | n < 0 = error "negative!"+ | otherwise = go (fromIntegral n)+ where+ go 0 = 0+ go 1 = 1+ go n = go (n-1) + go (n-2) fact :: Int -> Integer fact n | n < 0 = error "negative!" | otherwise = go (fromIntegral n)- where go i | i == 0 = 1- | otherwise = i * go (i-1)+ where go 0 = 1+ go i = i * go (i-1) fio :: Int -> IO Integer fio n | n < 0 = error "negative!"@@ -22,6 +25,11 @@ return $! i * j main = defaultMain [+ bgroup "tiny" [ bench "fib 10" $ \n -> fib (10+n-n)+ , bench "fib 15" $ \n -> fib (15+n-n)+ , bench "fib 20" $ \n -> fib (20+n-n)+ , bench "fib 25" $ \n -> fib (25+n-n)+ ], bgroup "fib" [ bench "fib 10" $ \n -> fib (10+n-n) , bench "fib 35" $ \n -> fib (35+n-n) , bench "fib 37" $ \n -> fib (37+n-n)