diff --git a/Criterion.hs b/Criterion.hs --- a/Criterion.hs +++ b/Criterion.hs @@ -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 diff --git a/Criterion/Analysis.hs b/Criterion/Analysis.hs --- a/Criterion/Analysis.hs +++ b/Criterion/Analysis.hs @@ -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" diff --git a/Criterion/Config.hs b/Criterion/Config.hs --- a/Criterion/Config.hs +++ b/Criterion/Config.hs @@ -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 } diff --git a/Criterion/Environment.hs b/Criterion/Environment.hs --- a/Criterion/Environment.hs +++ b/Criterion/Environment.hs @@ -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 diff --git a/Criterion/IO.hs b/Criterion/IO.hs --- a/Criterion/IO.hs +++ b/Criterion/IO.hs @@ -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 () + diff --git a/Criterion/Main.hs b/Criterion/Main.hs --- a/Criterion/Main.hs +++ b/Criterion/Main.hs @@ -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. diff --git a/Criterion/Monad.hs b/Criterion/Monad.hs new file mode 100644 --- /dev/null +++ b/Criterion/Monad.hs @@ -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 diff --git a/Criterion/Plot.hs b/Criterion/Plot.hs --- a/Criterion/Plot.hs +++ b/Criterion/Plot.hs @@ -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 diff --git a/criterion.cabal b/criterion.cabal --- a/criterion.cabal +++ b/criterion.cabal @@ -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 maintainer: Bryan O'Sullivan 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 diff --git a/examples/Fibber.hs b/examples/Fibber.hs --- a/examples/Fibber.hs +++ b/examples/Fibber.hs @@ -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)